diff options
Diffstat (limited to 'noao/onedspec/odcombine/srcwt/generic')
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icaclip.x | 2206 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icaverage.x | 522 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/iccclip.x | 1790 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icgdata.x | 1558 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icgrow.x | 263 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icmedian.x | 692 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icmm.x | 644 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icomb.x | 2054 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icpclip.x | 878 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icsclip.x | 1922 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icsigma.x | 562 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icsort.x | 1096 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/icstat.x | 892 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/mkpkg | 25 | ||||
| -rw-r--r-- | noao/onedspec/odcombine/srcwt/generic/xtimmap.x | 1079 |
15 files changed, 16183 insertions, 0 deletions
diff --git a/noao/onedspec/odcombine/srcwt/generic/icaclip.x b/noao/onedspec/odcombine/srcwt/generic/icaclip.x new file mode 100644 index 00000000..97c12346 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icaclip.x @@ -0,0 +1,2206 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number of images for this algorithm + + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclips (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mems[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Mems[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mems[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclips (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +real med, low, high, r, s, s1, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Mems[d[1]+k] + else { + low = Mems[d[1]+k] + high = Mems[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Mems[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Mems[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Mems[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Mems[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclipi (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Memi[d[1]+k] + high = Memi[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memi[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memi[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Memi[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memi[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memi[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memi[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memi[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclipi (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +real med, low, high, r, s, s1, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Memi[d[1]+k] + else { + low = Memi[d[1]+k] + high = Memi[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memi[d[n3-1]+k] + high = Memi[d[n3]+k] + med = (low + high) / 2. + } else + med = Memi[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Memi[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Memi[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Memi[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Memi[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Memi[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memi[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memi[d[n3-1]+k] + high = Memi[d[n3]+k] + med = (low + high) / 2. + } else + med = Memi[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memi[d[n3-1]+k] + high = Memi[d[n3]+k] + med = (low + high) / 2. + } else + med = Memi[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+k] = Memi[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memi[d[l]+k] = Memi[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclipr (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memr[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Memr[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memr[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclipr (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +real med, low, high, r, s, s1, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Memr[d[1]+k] + else { + low = Memr[d[1]+k] + high = Memr[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Memr[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Memr[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Memr[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Memr[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclipd (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +double average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +double d1, low, high, sum, a, s, s1, r, one +data one /1.0D0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Memd[d[1]+k] + high = Memd[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memd[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memd[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Memd[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memd[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memd[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memd[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memd[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclipd (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +double median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +double med, low, high, r, s, s1, one +data one /1.0D0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Memd[d[1]+k] + else { + low = Memd[d[1]+k] + high = Memd[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memd[d[n3-1]+k] + high = Memd[d[n3]+k] + med = (low + high) / 2. + } else + med = Memd[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Memd[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Memd[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Memd[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Memd[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Memd[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memd[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memd[d[n3-1]+k] + high = Memd[d[n3]+k] + med = (low + high) / 2. + } else + med = Memd[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memd[d[n3-1]+k] + high = Memd[d[n3]+k] + med = (low + high) / 2. + } else + med = Memd[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+k] = Memd[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memd[d[l]+k] = Memd[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icaverage.x b/noao/onedspec/odcombine/srcwt/generic/icaverage.x new file mode 100644 index 00000000..4b464e91 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icaverage.x @@ -0,0 +1,522 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averages (d, m, n, wts, w, npts, doblank, doaverage, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum without checking + # the number of points and using the fact that the weights are + # normalized. If all the data has been excluded set the average/sum + # to the blank value if requested. + + if (dflag == D_ALL && w[1] == NULL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mems[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mems[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mems[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mems[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = Memr[w[Memi[m[1]+k]]+k] + sum = Mems[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + Mems[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averagei (d, m, n, wts, w, npts, doblank, doaverage, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum without checking + # the number of points and using the fact that the weights are + # normalized. If all the data has been excluded set the average/sum + # to the blank value if requested. + + if (dflag == D_ALL && w[1] == NULL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memi[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memi[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Memi[d[1]+k] + do j = 2, n[i] + sum = sum + Memi[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memi[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memi[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memi[d[1]+k] + do j = 2, n[i] + sum = sum + Memi[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = Memr[w[Memi[m[1]+k]]+k] + sum = Memi[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + Memi[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memi[d[1]+k] + do j = 2, n[i] + sum = sum + Memi[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Memi[d[1]+k] + do j = 2, n[i] + sum = sum + Memi[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averager (d, m, n, wts, w, npts, doblank, doaverage, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum without checking + # the number of points and using the fact that the weights are + # normalized. If all the data has been excluded set the average/sum + # to the blank value if requested. + + if (dflag == D_ALL && w[1] == NULL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memr[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memr[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memr[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memr[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = Memr[w[Memi[m[1]+k]]+k] + sum = Memr[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + Memr[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averaged (d, m, n, wts, w, npts, doblank, doaverage, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +double average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +double sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum without checking + # the number of points and using the fact that the weights are + # normalized. If all the data has been excluded set the average/sum + # to the blank value if requested. + + if (dflag == D_ALL && w[1] == NULL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memd[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memd[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Memd[d[1]+k] + do j = 2, n[i] + sum = sum + Memd[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memd[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memd[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memd[d[1]+k] + do j = 2, n[i] + sum = sum + Memd[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = Memr[w[Memi[m[1]+k]]+k] + sum = Memd[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + Memd[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memd[d[1]+k] + do j = 2, n[i] + sum = sum + Memd[d[j]+k] + average[i] = sum / n[i] + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Memd[d[1]+k] + do j = 2, n[i] + sum = sum + Memd[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + diff --git a/noao/onedspec/odcombine/srcwt/generic/iccclip.x b/noao/onedspec/odcombine/srcwt/generic/iccclip.x new file mode 100644 index 00000000..bf655477 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/iccclip.x @@ -0,0 +1,1790 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 2 # Mininum number of images for algorithm + + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclips (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Mems[d[1]+k] + sum = sum + Mems[d[2]+k] + a = sum / 2 + } else { + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclips (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +real med, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Mems[d[n3-1]+k] + med = (med + Mems[d[n3]+k]) / 2. + } else + med = Mems[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclipi (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Memi[d[1]+k] + sum = sum + Memi[d[2]+k] + a = sum / 2 + } else { + low = Memi[d[1]+k] + high = Memi[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memi[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Memi[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Memi[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memi[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memi[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclipi (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +real med, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Memi[d[n3-1]+k] + med = (med + Memi[d[n3]+k]) / 2. + } else + med = Memi[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Memi[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Memi[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Memi[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Memi[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+k] = Memi[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memi[d[l]+k] = Memi[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclipr (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Memr[d[1]+k] + sum = sum + Memr[d[2]+k] + a = sum / 2 + } else { + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclipr (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +real med, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Memr[d[n3-1]+k] + med = (med + Memr[d[n3]+k]) / 2. + } else + med = Memr[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclipd (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +double average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +double d1, low, high, sum, a, s, r, zero +data zero /0.0D0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Memd[d[1]+k] + sum = sum + Memd[d[2]+k] + a = sum / 2 + } else { + low = Memd[d[1]+k] + high = Memd[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memd[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Memd[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Memd[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memd[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memd[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclipd (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +double median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +double med, zero +data zero /0.0D0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Memd[d[n3-1]+k] + med = (med + Memd[d[n3]+k]) / 2. + } else + med = Memd[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Memd[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Memd[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Memd[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Memd[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+k] = Memd[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memd[d[l]+k] = Memd[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icgdata.x b/noao/onedspec/odcombine/srcwt/generic/icgdata.x new file mode 100644 index 00000000..1350ad21 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icgdata.x @@ -0,0 +1,1558 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" + + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is kept in the returned m data pointers. + +procedure ic_gdatas (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers +pointer d[nimages] # Data pointers +pointer wtp[nimages] # Weight images +pointer wbuf[nimages] # Weight buffers +pointer w[nimages] # Weight pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnls() +int xt_imgnlr() +long v3[IM_MAXDIM] +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnls + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2]) + } + j = xt_imgnls (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2]) + call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix) + w[i] = wbuf[i] + } + l = xt_imgnls (in[i], i, buf, v2, v1[2]) + call amovs (Mems[buf+k-1], Mems[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Memr[dp] = Memr[dp] / a + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + } + + # Compute weights from sigmas. + if (wtype == S_SIGMAP) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Mems[d[k]+j-1] = Mems[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Mems[d[k]+j-1] = Mems[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_SHORT) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sorts (d, Mems[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sorts (d, Mems[dp], n, npts) + call mfree (dp, TY_SHORT) + } +end + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is kept in the returned m data pointers. + +procedure ic_gdatai (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers +pointer d[nimages] # Data pointers +pointer wtp[nimages] # Weight images +pointer wbuf[nimages] # Weight buffers +pointer w[nimages] # Weight pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnli() +int xt_imgnlr() +long v3[IM_MAXDIM] +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnli + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2]) + } + j = xt_imgnli (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2]) + call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix) + w[i] = wbuf[i] + } + l = xt_imgnli (in[i], i, buf, v2, v1[2]) + call amovi (Memi[buf+k-1], Memi[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Memi[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Memi[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Memi[dp] = Memi[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Memi[dp] = Memi[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Memi[dp] = Memi[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Memr[dp] = Memr[dp] / a + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + } + + # Compute weights from sigmas. + if (wtype == S_SIGMAP) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Memi[d[k]+j-1] = Memi[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Memi[d[k]+j-1] = Memi[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_INT) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sorti (d, Memi[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sorti (d, Memi[dp], n, npts) + call mfree (dp, TY_INT) + } +end + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is kept in the returned m data pointers. + +procedure ic_gdatar (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers +pointer d[nimages] # Data pointers +pointer wtp[nimages] # Weight images +pointer wbuf[nimages] # Weight buffers +pointer w[nimages] # Weight pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnlr() +long v3[IM_MAXDIM] +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnlr + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2]) + } + j = xt_imgnlr (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2]) + call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix) + w[i] = wbuf[i] + } + l = xt_imgnlr (in[i], i, buf, v2, v1[2]) + call amovr (Memr[buf+k-1], Memr[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Memr[dp] = Memr[dp] / a + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + } + + # Compute weights from sigmas. + if (wtype == S_SIGMAP) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Memr[d[k]+j-1] = Memr[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Memr[d[k]+j-1] = Memr[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_REAL) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sortr (d, Memr[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sortr (d, Memr[dp], n, npts) + call mfree (dp, TY_REAL) + } +end + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is kept in the returned m data pointers. + +procedure ic_gdatad (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers +pointer d[nimages] # Data pointers +pointer wtp[nimages] # Weight images +pointer wbuf[nimages] # Weight buffers +pointer w[nimages] # Weight pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, xt_imgnld() +int xt_imgnlr() +long v3[IM_MAXDIM] +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnld + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) { + call xt_cpix (i) + call xt_cpix (nimages+i) + } + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + j = xt_imgnlr (wtp[i], nimages+i, w[i], v3, v1[2]) + } + j = xt_imgnld (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + if (wtp[i] != NULL) { + call amovl (v2, v3, IM_MAXDIM) + l = xt_imgnlr (wtp[i], nimages+i, buf, v3, v1[2]) + call amovr (Memr[buf+k-1], Memr[wbuf[i]+j], npix) + w[i] = wbuf[i] + } + l = xt_imgnld (in[i], i, buf, v2, v1[2]) + call amovd (Memd[buf+k-1], Memd[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Memd[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Memd[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Memd[dp] = Memd[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Memd[dp] = Memd[dp] / a + b + dp = dp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + dp = dp + 1 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Memd[dp] = Memd[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + if (wtype == S_SIGMAP) { + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) + Memr[dp] = Memr[dp] / a + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + } + + # Compute weights from sigmas. + if (wtype == S_SIGMAP) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = w[i] + do j = 1, npts { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = w[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + a = Memr[dp] + if (a > 0.) + Memr[dp] = 1. / (a**2) + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Memd[d[k]+j-1] = Memd[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Memd[d[k]+j-1] = Memd[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_DOUBLE) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sortd (d, Memd[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sortd (d, Memd[dp], n, npts) + call mfree (dp, TY_DOUBLE) + } +end + diff --git a/noao/onedspec/odcombine/srcwt/generic/icgrow.x b/noao/onedspec/odcombine/srcwt/generic/icgrow.x new file mode 100644 index 00000000..1ccb7885 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icgrow.x @@ -0,0 +1,263 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <pmset.h> +include "../icombine.h" + +# IC_GROW -- Mark neigbors of rejected pixels. +# The rejected pixels (original plus grown) are saved in pixel masks. + +procedure ic_grow (out, v, m, n, buf, nimages, npts, pms) + +pointer out # Output image pointer +long v[ARB] # Output vector +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[npts,nimages] # Working buffer +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k, l, line, nl, rop, igrow, nset, ncompress, or() +real grow2, i2 +pointer mp, pm, pm_newmask() +errchk pm_newmask() + +include "../icombine.com" + +begin + if (dflag == D_NONE || grow == 0.) + return + + line = v[2] + nl = IM_LEN(out,2) + rop = or (PIX_SRC, PIX_DST) + + igrow = grow + grow2 = grow**2 + do l = 0, igrow { + i2 = grow2 - l * l + call aclri (buf, npts*nimages) + nset = 0 + do j = 1, npts { + do k = n[j]+1, nimages { + mp = Memi[m[k]+j-1] + if (mp == 0) + next + do i = 0, igrow { + if (i**2 > i2) + next + if (j > i) + buf[j-i,mp] = 1 + if (j+i <= npts) + buf[j+i,mp] = 1 + nset = nset + 1 + } + } + } + if (nset == 0) + return + + if (pms == NULL) { + call malloc (pms, nimages, TY_POINTER) + do i = 1, nimages + Memi[pms+i-1] = pm_newmask (out, 1) + ncompress = 0 + } + do i = 1, nimages { + pm = Memi[pms+i-1] + v[2] = line - l + if (v[2] > 0) + call pmplpi (pm, v, buf[1,i], 1, npts, rop) + if (l > 0) { + v[2] = line + l + if (v[2] <= nl) + call pmplpi (pm, v, buf[1,i], 1, npts, rop) + } + } + } + v[2] = line + + if (ncompress > 10) { + do i = 1, nimages { + pm = Memi[pms+i-1] + call pm_compress (pm) + } + ncompress = 0 + } else + ncompress = ncompress + 1 +end + + + +# IC_GROW$T -- Reject pixels. + +procedure ic_grows (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Mems[d[j]+i-1] = Mems[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end + +# IC_GROW$T -- Reject pixels. + +procedure ic_growi (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Memi[d[j]+i-1] = Memi[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end + +# IC_GROW$T -- Reject pixels. + +procedure ic_growr (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Memr[d[j]+i-1] = Memr[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end + +# IC_GROW$T -- Reject pixels. + +procedure ic_growd (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Memd[d[j]+i-1] = Memd[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icmedian.x b/noao/onedspec/odcombine/srcwt/generic/icmedian.x new file mode 100644 index 00000000..1a2ed72d --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icmedian.x @@ -0,0 +1,692 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_MEDIAN -- Median of lines + +procedure ic_medians (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +short temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + median[i]= blank + } + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Mems[d[j1]+k] + val2 = Mems[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mems[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Mems[d[j1]+k] + val2 = Mems[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mems[d[j1]+k] + } else if (doblank == YES) + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mems[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Mems[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Mems[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mems[d[lo1]+k] + Mems[d[lo1]+k] = Mems[d[up1]+k] + Mems[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Mems[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mems[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Mems[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Mems[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mems[d[lo1]+k] + Mems[d[lo1]+k] = Mems[d[up1]+k] + Mems[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Mems[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Mems[d[1]+k] + val2 = Mems[d[2]+k] + val3 = Mems[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Mems[d[1]+k] + val2 = Mems[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Mems[d[1]+k] + + # If no points return with a possibly blank value. + else if (doblank == YES) + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_mediani (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +int temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + median[i]= blank + } + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Memi[d[j1]+k] + val2 = Memi[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memi[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Memi[d[j1]+k] + val2 = Memi[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memi[d[j1]+k] + } else if (doblank == YES) + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memi[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memi[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memi[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memi[d[lo1]+k] + Memi[d[lo1]+k] = Memi[d[up1]+k] + Memi[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Memi[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memi[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memi[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memi[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memi[d[lo1]+k] + Memi[d[lo1]+k] = Memi[d[up1]+k] + Memi[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Memi[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Memi[d[1]+k] + val2 = Memi[d[2]+k] + val3 = Memi[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Memi[d[1]+k] + val2 = Memi[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Memi[d[1]+k] + + # If no points return with a possibly blank value. + else if (doblank == YES) + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_medianr (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +real temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + median[i]= blank + } + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Memr[d[j1]+k] + val2 = Memr[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memr[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Memr[d[j1]+k] + val2 = Memr[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memr[d[j1]+k] + } else if (doblank == YES) + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memr[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memr[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memr[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memr[d[lo1]+k] + Memr[d[lo1]+k] = Memr[d[up1]+k] + Memr[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Memr[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memr[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memr[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memr[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memr[d[lo1]+k] + Memr[d[lo1]+k] = Memr[d[up1]+k] + Memr[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Memr[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Memr[d[1]+k] + val2 = Memr[d[2]+k] + val3 = Memr[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Memr[d[1]+k] + val2 = Memr[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Memr[d[1]+k] + + # If no points return with a possibly blank value. + else if (doblank == YES) + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_mediand (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +double median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +double val1, val2, val3 +double temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + median[i]= blank + } + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Memd[d[j1]+k] + val2 = Memd[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memd[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Memd[d[j1]+k] + val2 = Memd[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memd[d[j1]+k] + } else if (doblank == YES) + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memd[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memd[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memd[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memd[d[lo1]+k] + Memd[d[lo1]+k] = Memd[d[up1]+k] + Memd[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Memd[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memd[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memd[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memd[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memd[d[lo1]+k] + Memd[d[lo1]+k] = Memd[d[up1]+k] + Memd[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Memd[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Memd[d[1]+k] + val2 = Memd[d[2]+k] + val3 = Memd[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Memd[d[1]+k] + val2 = Memd[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Memd[d[1]+k] + + # If no points return with a possibly blank value. + else if (doblank == YES) + median[i] = blank + } +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icmm.x b/noao/onedspec/odcombine/srcwt/generic/icmm.x new file mode 100644 index 00000000..5b2b13bf --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icmm.x @@ -0,0 +1,644 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mms (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +short d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Mems[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Mems[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Mems[kmax] = d2 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Mems[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Mems[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Mems[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } else { + if (jmax < j) { + if (jmin != j) + Mems[kmax] = d2 + else + Mems[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Mems[kmin] = d1 + else + Mems[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Mems[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Mems[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Mems[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmin < n1) + Mems[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Mems[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Mems[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Mems[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmax < n1) + Mems[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mmi (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +int d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Memi[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Memi[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Memi[kmax] = d2 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Memi[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Memi[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Memi[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } else { + if (jmax < j) { + if (jmin != j) + Memi[kmax] = d2 + else + Memi[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Memi[kmin] = d1 + else + Memi[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Memi[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memi[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Memi[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmin < n1) + Memi[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Memi[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memi[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Memi[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmax < n1) + Memi[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mmr (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +real d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Memr[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Memr[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Memr[kmax] = d2 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Memr[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Memr[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Memr[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } else { + if (jmax < j) { + if (jmin != j) + Memr[kmax] = d2 + else + Memr[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Memr[kmin] = d1 + else + Memr[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Memr[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memr[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Memr[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmin < n1) + Memr[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Memr[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memr[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Memr[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmax < n1) + Memr[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mmd (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +double d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Memd[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Memd[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Memd[kmax] = d2 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Memd[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Memd[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Memd[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } else { + if (jmax < j) { + if (jmin != j) + Memd[kmax] = d2 + else + Memd[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Memd[kmin] = d1 + else + Memd[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Memd[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memd[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Memd[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmin < n1) + Memd[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Memd[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memd[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Memd[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmax < n1) + Memd[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icomb.x b/noao/onedspec/odcombine/srcwt/generic/icomb.x new file mode 100644 index 00000000..df4290b8 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icomb.x @@ -0,0 +1,2054 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "../icombine.h" + +# The following is for compiling under V2.11. +define IM_BUFFRAC IM_BUFSIZE +include <imset.h> + + +# ICOMBINE -- Combine images +# +# The memory and open file descriptor limits are checked and an attempt +# to recover is made either by setting the image pixel files to be +# closed after I/O or by notifying the calling program that memory +# ran out and the IMIO buffer size should be reduced. After the checks +# a procedure for the selected combine option is called. +# Because there may be several failure modes when reaching the file +# limits we first assume an error is due to the file limit, except for +# out of memory, and close some pixel files. If the error then repeats +# on accessing the pixels the error is passed back. + + +procedure icombines (in, out, scales, zeros, wts, wtp, offsets, nimages, + bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +pointer wtp[nimages] # Weight image pointers +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnls() +pointer sp, d, w, id, n, m, lflag, v, dbuf, wbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnls, impl1i, ic_combines +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + call salloc (d, nimages, TY_POINTER) + call salloc (wbuf, nimages, TY_POINTER) + call salloc (w, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (v, IM_MAXDIM, TY_LONG) + call amovki (NULL, Memi[dbuf], nimages) + call amovki (NULL, Memi[d], nimages) + call amovki (NULL, Memi[wbuf], nimages) + call amovki (NULL, Memi[w], nimages) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_SHORT) + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 0) + if (im != in[i]) + call salloc (Memi[dbuf+i-1], npts, TY_SHORT) + } + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnls (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combines (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, scales, zeros, wts, + wtp, Memi[wbuf], Memi[w], nimages, npts) + + call sfree (sp) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combines (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, wtp, wbuf, w, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +pointer wtp[nimages] # Combining weight image pointers +pointer wbuf[nimages] # Weight buffers for nonaligned images +pointer w[nimages] # Weight pointers +int nimages # Number of input images +int npts # Number of points per output line + +int i, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nm, pms +pointer immap(), impnli(), xt_opix() +pointer impnlr(), imgnlr() +errchk immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks +errchk ic_grows, ic_gdatas + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, wtp, nimages, npts) + + # Allocate weight buffers if needed. + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + if (!aligned) { + do i = 1, nimages + call salloc (wbuf[i], npts, TY_REAL) + } else { + do i = 1, nimages { + if (wtp[i] != xt_opix (wtp[i], nimages+i, 0)) + call salloc (wbuf[i], npts, TY_REAL) + } + } + } + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatas (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, + offsets, scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclips (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclips (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mms (d, id, n, npts) + case PCLIP: + call ic_pclips (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclips (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclips (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclips (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclips (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averages (d, id, n, wts, w, npts, YES, YES, + Memr[outdata]) + case MEDIAN: + call ic_medians (d, n, npts, YES, Memr[outdata]) + case SUM: + call ic_averages (d, id, n, wts, w, npts, YES, NO, + Memr[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmas (d, id, n, wts, w, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatas (in, out, dbuf, d, wtp, wbuf, w, id, n, m, + lflag, offsets, scales, zeros, nimages, npts, + Meml[v2], Meml[v3]) + + call ic_grows (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnlr (out[1], buf, Meml[v1]) == EOF) + ; + call amovr (Memr[buf], Memr[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averages (d, id, n, wts, w, npts, NO, YES, + Memr[outdata]) + case MEDIAN: + call ic_medians (d, n, npts, NO, Memr[outdata]) + case SUM: + call ic_averages (d, id, n, wts, w, npts, NO, NO, + Memr[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmas (d, id, n, wts, w, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + do i = 1, nimages + call xt_imunmap (wtp[i], nimages+i) + } + call sfree (sp) +end + +procedure icombinei (in, out, scales, zeros, wts, wtp, offsets, nimages, + bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +pointer wtp[nimages] # Weight image pointers +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnli() +pointer sp, d, w, id, n, m, lflag, v, dbuf, wbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnli, impl1i, ic_combinei +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + call salloc (d, nimages, TY_POINTER) + call salloc (wbuf, nimages, TY_POINTER) + call salloc (w, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (v, IM_MAXDIM, TY_LONG) + call amovki (NULL, Memi[dbuf], nimages) + call amovki (NULL, Memi[d], nimages) + call amovki (NULL, Memi[wbuf], nimages) + call amovki (NULL, Memi[w], nimages) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_INT) + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 0) + if (im != in[i]) + call salloc (Memi[dbuf+i-1], npts, TY_INT) + } + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnli (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combinei (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, scales, zeros, wts, + wtp, Memi[wbuf], Memi[w], nimages, npts) + + call sfree (sp) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combinei (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, wtp, wbuf, w, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +pointer wtp[nimages] # Combining weight image pointers +pointer wbuf[nimages] # Weight buffers for nonaligned images +pointer w[nimages] # Weight pointers +int nimages # Number of input images +int npts # Number of points per output line + +int i, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nm, pms +pointer immap(), impnli(), xt_opix() +pointer impnlr(), imgnlr() +errchk immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks +errchk ic_growi, ic_gdatai + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, wtp, nimages, npts) + + # Allocate weight buffers if needed. + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + if (!aligned) { + do i = 1, nimages + call salloc (wbuf[i], npts, TY_REAL) + } else { + do i = 1, nimages { + if (wtp[i] != xt_opix (wtp[i], nimages+i, 0)) + call salloc (wbuf[i], npts, TY_REAL) + } + } + } + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatai (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, + offsets, scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclipi (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclipi (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mmi (d, id, n, npts) + case PCLIP: + call ic_pclipi (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclipi (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclipi (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclipi (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclipi (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averagei (d, id, n, wts, w, npts, YES, YES, + Memr[outdata]) + case MEDIAN: + call ic_mediani (d, n, npts, YES, Memr[outdata]) + case SUM: + call ic_averagei (d, id, n, wts, w, npts, YES, NO, + Memr[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmai (d, id, n, wts, w, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatai (in, out, dbuf, d, wtp, wbuf, w, id, n, m, + lflag, offsets, scales, zeros, nimages, npts, + Meml[v2], Meml[v3]) + + call ic_growi (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnlr (out[1], buf, Meml[v1]) == EOF) + ; + call amovr (Memr[buf], Memr[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averagei (d, id, n, wts, w, npts, NO, YES, + Memr[outdata]) + case MEDIAN: + call ic_mediani (d, n, npts, NO, Memr[outdata]) + case SUM: + call ic_averagei (d, id, n, wts, w, npts, NO, NO, + Memr[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmai (d, id, n, wts, w, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + do i = 1, nimages + call xt_imunmap (wtp[i], nimages+i) + } + call sfree (sp) +end + +procedure icombiner (in, out, scales, zeros, wts, wtp, offsets, nimages, + bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +pointer wtp[nimages] # Weight image pointers +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnlr() +pointer sp, d, w, id, n, m, lflag, v, dbuf, wbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnlr, impl1i, ic_combiner +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + call salloc (d, nimages, TY_POINTER) + call salloc (wbuf, nimages, TY_POINTER) + call salloc (w, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (v, IM_MAXDIM, TY_LONG) + call amovki (NULL, Memi[dbuf], nimages) + call amovki (NULL, Memi[d], nimages) + call amovki (NULL, Memi[wbuf], nimages) + call amovki (NULL, Memi[w], nimages) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_REAL) + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 0) + if (im != in[i]) + call salloc (Memi[dbuf+i-1], npts, TY_REAL) + } + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnlr (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combiner (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, scales, zeros, wts, + wtp, Memi[wbuf], Memi[w], nimages, npts) + + call sfree (sp) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combiner (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, wtp, wbuf, w, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +pointer wtp[nimages] # Combining weight image pointers +pointer wbuf[nimages] # Weight buffers for nonaligned images +pointer w[nimages] # Weight pointers +int nimages # Number of input images +int npts # Number of points per output line + +int i, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nm, pms +pointer immap(), impnli(), xt_opix() +pointer impnlr(), imgnlr +errchk immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks +errchk ic_growr, ic_gdatar + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, wtp, nimages, npts) + + # Allocate weight buffers if needed. + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + if (!aligned) { + do i = 1, nimages + call salloc (wbuf[i], npts, TY_REAL) + } else { + do i = 1, nimages { + if (wtp[i] != xt_opix (wtp[i], nimages+i, 0)) + call salloc (wbuf[i], npts, TY_REAL) + } + } + } + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatar (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, + offsets, scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclipr (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclipr (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mmr (d, id, n, npts) + case PCLIP: + call ic_pclipr (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclipr (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclipr (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclipr (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclipr (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averager (d, id, n, wts, w, npts, YES, YES, + Memr[outdata]) + case MEDIAN: + call ic_medianr (d, n, npts, YES, Memr[outdata]) + case SUM: + call ic_averager (d, id, n, wts, w, npts, YES, NO, + Memr[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + buf = buf + 1 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmar (d, id, n, wts, w, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatar (in, out, dbuf, d, wtp, wbuf, w, id, n, m, + lflag, offsets, scales, zeros, nimages, npts, + Meml[v2], Meml[v3]) + + call ic_growr (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnlr (out[1], buf, Meml[v1]) == EOF) + ; + call amovr (Memr[buf], Memr[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averager (d, id, n, wts, w, npts, NO, YES, + Memr[outdata]) + case MEDIAN: + call ic_medianr (d, n, npts, NO, Memr[outdata]) + case SUM: + call ic_averager (d, id, n, wts, w, npts, NO, NO, + Memr[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmar (d, id, n, wts, w, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + do i = 1, nimages + call xt_imunmap (wtp[i], nimages+i) + } + call sfree (sp) +end + +procedure icombined (in, out, scales, zeros, wts, wtp, offsets, nimages, + bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +pointer wtp[nimages] # Weight image pointers +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnld() +pointer sp, d, w, id, n, m, lflag, v, dbuf, wbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnld, impl1i, ic_combined +pointer impl1d() +errchk impl1d + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + call salloc (d, nimages, TY_POINTER) + call salloc (wbuf, nimages, TY_POINTER) + call salloc (w, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (v, IM_MAXDIM, TY_LONG) + call amovki (NULL, Memi[dbuf], nimages) + call amovki (NULL, Memi[d], nimages) + call amovki (NULL, Memi[wbuf], nimages) + call amovki (NULL, Memi[w], nimages) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_DOUBLE) + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 0) + if (im != in[i]) + call salloc (Memi[dbuf+i-1], npts, TY_DOUBLE) + } + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + buf = impl1d (out[1]) + call aclrd (Memd[buf], npts) + if (out[3] != NULL) { + buf = impl1d (out[3]) + call aclrd (Memd[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnld (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combined (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, scales, zeros, wts, + wtp, Memi[wbuf], Memi[w], nimages, npts) + + call sfree (sp) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combined (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, wtp, wbuf, w, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +pointer wtp[nimages] # Combining weight image pointers +pointer wbuf[nimages] # Weight buffers for nonaligned images +pointer w[nimages] # Weight pointers +int nimages # Number of input images +int npts # Number of points per output line + +int i, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nm, pms +pointer immap(), impnli(), xt_opix() +pointer impnld(), imgnld +errchk immap, ic_scale, xt_opix, imgetr, ic_grow, ic_rmasks +errchk ic_growd, ic_gdatad + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, wtp, nimages, npts) + + # Allocate weight buffers if needed. + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + if (!aligned) { + do i = 1, nimages + call salloc (wbuf[i], npts, TY_REAL) + } else { + do i = 1, nimages { + if (wtp[i] != xt_opix (wtp[i], nimages+i, 0)) + call salloc (wbuf[i], npts, TY_REAL) + } + } + } + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnld (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatad (in, out, dbuf, d, wtp, wbuf, w, id, n, m, lflag, + offsets, scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclipd (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memd[outdata]) + else + call ic_accdclipd (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memd[outdata]) + case MINMAX: + call ic_mmd (d, id, n, npts) + case PCLIP: + call ic_pclipd (d, id, n, nimages, npts, Memd[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclipd (d, id, n, scales, zeros, nimages, npts, + Memd[outdata]) + else + call ic_asigclipd (d, id, n, scales, zeros, nimages, npts, + Memd[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclipd (d, id, n, scales, zeros, nimages, + npts, Memd[outdata]) + else + call ic_aavsigclipd (d, id, n, scales, zeros, nimages, + npts, Memd[outdata]) + } + + if (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averaged (d, id, n, wts, w, npts, YES, YES, + Memd[outdata]) + case MEDIAN: + call ic_mediand (d, n, npts, YES, Memd[outdata]) + case SUM: + call ic_averaged (d, id, n, wts, w, npts, YES, NO, + Memd[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + buf = buf + 1 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnld (out[3], buf, Meml[v1]) + call ic_sigmad (d, id, n, wts, w, npts, Memd[outdata], + Memd[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + while (impnld (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatad (in, out, dbuf, d, wtp, wbuf, w, id, n, m, + lflag, offsets, scales, zeros, nimages, npts, + Meml[v2], Meml[v3]) + + call ic_growd (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnld (out[1], buf, Meml[v1]) == EOF) + ; + call amovd (Memd[buf], Memd[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averaged (d, id, n, wts, w, npts, NO, YES, + Memd[outdata]) + case MEDIAN: + call ic_mediand (d, n, npts, NO, Memd[outdata]) + case SUM: + call ic_averaged (d, id, n, wts, w, npts, NO, NO, + Memd[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 0 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnld (out[3], buf, Meml[v1]) + call ic_sigmad (d, id, n, wts, w, npts, Memd[outdata], + Memd[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, w, + npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + if (wtype == S_WTMAP || wtype == S_SIGMAP) { + do i = 1, nimages + call xt_imunmap (wtp[i], nimages+i) + } + call sfree (sp) +end + diff --git a/noao/onedspec/odcombine/srcwt/generic/icpclip.x b/noao/onedspec/odcombine/srcwt/generic/icpclip.x new file mode 100644 index 00000000..237d9686 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icpclip.x @@ -0,0 +1,878 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number for clipping + + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclips (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +real med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Mems[d[n2-1]+j] + med = (med + Mems[d[n2]+j]) / 2. + } else + med = Mems[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Mems[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Mems[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Mems[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Mems[d[n5-1]+j] + med = (med + Mems[d[n5]+j]) / 2. + } else + med = Mems[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+j] = Mems[d[k]+j] + if (grow >= 1.) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+j] = Mems[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclipi (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +real med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Memi[d[n2-1]+j] + med = (med + Memi[d[n2]+j]) / 2. + } else + med = Memi[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Memi[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Memi[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Memi[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Memi[d[n5-1]+j] + med = (med + Memi[d[n5]+j]) / 2. + } else + med = Memi[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+j] = Memi[d[k]+j] + if (grow >= 1.) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memi[d[l]+j] = Memi[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclipr (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +real med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Memr[d[n2-1]+j] + med = (med + Memr[d[n2]+j]) / 2. + } else + med = Memr[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Memr[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Memr[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Memr[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Memr[d[n5-1]+j] + med = (med + Memr[d[n5]+j]) / 2. + } else + med = Memr[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+j] = Memr[d[k]+j] + if (grow >= 1.) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+j] = Memr[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclipd (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +double median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +double med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Memd[d[n2-1]+j] + med = (med + Memd[d[n2]+j]) / 2. + } else + med = Memd[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Memd[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Memd[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Memd[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Memd[d[n5-1]+j] + med = (med + Memd[d[n5]+j]) / 2. + } else + med = Memd[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+j] = Memd[d[k]+j] + if (grow >= 1.) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memd[d[l]+j] = Memd[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icsclip.x b/noao/onedspec/odcombine/srcwt/generic/icsclip.x new file mode 100644 index 00000000..a0188d72 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icsclip.x @@ -0,0 +1,1922 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Mininum number of images for algorithm + + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclips (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, one +data one /1.0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mems[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mems[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Mems[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclips (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +real med, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Mems[d[n3-1]+k] + Mems[d[n3]+k]) / 2. + else + med = Mems[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Mems[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Mems[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclipi (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, one +data one /1.0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Memi[d[1]+k] + high = Memi[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memi[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memi[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memi[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Memi[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memi[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memi[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memi[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclipi (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +real med, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Memi[d[n3-1]+k] + Memi[d[n3]+k]) / 2. + else + med = Memi[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Memi[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memi[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memi[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Memi[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memi[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memi[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+k] = Memi[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memi[d[l]+k] = Memi[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclipr (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, one +data one /1.0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memr[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memr[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Memr[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclipr (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +real med, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Memr[d[n3-1]+k] + Memr[d[n3]+k]) / 2. + else + med = Memr[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Memr[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Memr[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclipd (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +double average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +double d1, low, high, sum, a, s, r, one +data one /1.0D0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Memd[d[1]+k] + high = Memd[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memd[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memd[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memd[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Memd[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memd[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memd[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memd[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclipd (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +double median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +double med, one +data one /1.0D0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Memd[d[n3-1]+k] + Memd[d[n3]+k]) / 2. + else + med = Memd[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Memd[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memd[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memd[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Memd[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memd[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memd[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+k] = Memd[d[j]+k] + if (grow >= 1.) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memd[d[l]+k] = Memd[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icsigma.x b/noao/onedspec/odcombine/srcwt/generic/icsigma.x new file mode 100644 index 00000000..c66faba9 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icsigma.x @@ -0,0 +1,562 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmas (d, m, n, wts, w, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +real average[npts] # Average +real sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +real a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL && w[1] == NULL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mems[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mems[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mems[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mems[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = Memr[w[Memi[m[1]+k]]+k] + sum = (Mems[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + (Mems[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmai (d, m, n, wts, w, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +real average[npts] # Average +real sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +real a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL && w[1] == NULL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memi[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memi[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Memi[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memi[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memi[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memi[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memi[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memi[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = Memr[w[Memi[m[1]+k]]+k] + sum = (Memi[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + (Memi[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memi[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memi[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Memi[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memi[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmar (d, m, n, wts, w, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +real average[npts] # Average +real sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +real a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL && w[1] == NULL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memr[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memr[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memr[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memr[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = Memr[w[Memi[m[1]+k]]+k] + sum = (Memr[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + (Memr[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmad (d, m, n, wts, w, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +pointer w[ARB] # Weight data pointers +int npts # Number of output points per line +double average[npts] # Average +double sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +double a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL && w[1] == NULL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memd[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memd[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Memd[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memd[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + if (w[1] == NULL) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memd[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memd[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memd[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memd[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = Memr[w[Memi[m[1]+k]]+k] + sum = (Memd[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = Memr[w[Memi[m[j]+k]]+k] + sum = sum + (Memd[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memd[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memd[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * sigcor) + } + } else + sigma[i] = blank + } + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Memd[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memd[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end + diff --git a/noao/onedspec/odcombine/srcwt/generic/icsort.x b/noao/onedspec/odcombine/srcwt/generic/icsort.x new file mode 100644 index 00000000..3ec1d27e --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icsort.x @@ -0,0 +1,1096 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sorts (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +short b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +short pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Mems[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Mems[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Mems[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sorts (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +short b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +short pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Mems[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Mems[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sorti (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +int b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +int pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Memi[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Memi[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Memi[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sorti (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +int b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +int pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Memi[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Memi[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sortr (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +real b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +real pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Memr[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Memr[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Memr[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sortr (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +real b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +real pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Memr[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Memr[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sortd (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +double b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +double pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Memd[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Memd[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Memd[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sortd (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +double b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +double pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Memd[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Memd[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end diff --git a/noao/onedspec/odcombine/srcwt/generic/icstat.x b/noao/onedspec/odcombine/srcwt/generic/icstat.x new file mode 100644 index 00000000..3a0ed49c --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/icstat.x @@ -0,0 +1,892 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +define NMAX 100000 # Maximum number of pixels to sample + + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_stats (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnls() + +real asums() +short ic_modes() + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_SHORT) + dp = data + while (imgnls (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Mems[lp] + if (a >= lthresh && a <= hthresh) { + Mems[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Mems[dp] = Mems[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Mems[lp] + if (a >= lthresh && a <= hthresh) { + Mems[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Mems[dp] = Mems[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrts (Mems[data], Mems[data], n) + mode = ic_modes (Mems[data], n) + median = Mems[data+n/2-1] + } + if (domean) + mean = asums (Mems[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.7 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +short procedure ic_modes (a, n) + +short a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +short mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + zstep = max (1., zstep) + zbin = max (1., zbin) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_stati (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnli() + +real asumi() +int ic_modei() + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_INT) + dp = data + while (imgnli (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Memi[lp] + if (a >= lthresh && a <= hthresh) { + Memi[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Memi[dp] = Memi[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Memi[lp] + if (a >= lthresh && a <= hthresh) { + Memi[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Memi[dp] = Memi[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrti (Memi[data], Memi[data], n) + mode = ic_modei (Memi[data], n) + median = Memi[data+n/2-1] + } + if (domean) + mean = asumi (Memi[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.7 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +int procedure ic_modei (a, n) + +int a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +int mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + zstep = max (1., zstep) + zbin = max (1., zbin) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_statr (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnlr() + +real asumr() +real ic_moder() + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_REAL) + dp = data + while (imgnlr (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Memr[lp] + if (a >= lthresh && a <= hthresh) { + Memr[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Memr[dp] = Memr[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Memr[lp] + if (a >= lthresh && a <= hthresh) { + Memr[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Memr[dp] = Memr[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrtr (Memr[data], Memr[data], n) + mode = ic_moder (Memr[data], n) + median = Memr[data+n/2-1] + } + if (domean) + mean = asumr (Memr[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.7 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +real procedure ic_moder (a, n) + +real a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +real mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_statd (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnld() + +double asumd() +double ic_moded() + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_DOUBLE) + dp = data + while (imgnld (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, nimages, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Memd[lp] + if (a >= lthresh && a <= hthresh) { + Memd[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Memd[dp] = Memd[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Memd[lp] + if (a >= lthresh && a <= hthresh) { + Memd[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Memd[dp] = Memd[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrtd (Memd[data], Memd[data], n) + mode = ic_moded (Memd[data], n) + median = Memd[data+n/2-1] + } + if (domean) + mean = asumd (Memd[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.7 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +double procedure ic_moded (a, n) + +double a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +double mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + diff --git a/noao/onedspec/odcombine/srcwt/generic/mkpkg b/noao/onedspec/odcombine/srcwt/generic/mkpkg new file mode 100644 index 00000000..632b61c8 --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/mkpkg @@ -0,0 +1,25 @@ +# Make IMCOMBINE. + +$checkout libpkg.a ../../../../ +$update libpkg.a +$checkin libpkg.a ../../../../ +$exit + +libpkg.a: + icaclip.x ../icombine.com ../icombine.h + icaverage.x ../icombine.com ../icombine.h <imhdr.h> + iccclip.x ../icombine.com ../icombine.h + icgdata.x ../icombine.com ../icombine.h <imhdr.h> <mach.h> + icgrow.x ../icombine.com ../icombine.h <imhdr.h> <pmset.h> + icmedian.x ../icombine.com ../icombine.h + icmm.x ../icombine.com ../icombine.h + icomb.x ../icombine.com ../icombine.h <error.h> <imhdr.h>\ + <imset.h> <mach.h> <pmset.h> <syserr.h> + icpclip.x ../icombine.com ../icombine.h + icsclip.x ../icombine.com ../icombine.h + icsigma.x ../icombine.com ../icombine.h <imhdr.h> + icsort.x + icstat.x ../icombine.com ../icombine.h <imhdr.h> + + xtimmap.x xtimmap.com <config.h> <error.h> <imhdr.h> <imset.h> + ; diff --git a/noao/onedspec/odcombine/srcwt/generic/xtimmap.x b/noao/onedspec/odcombine/srcwt/generic/xtimmap.x new file mode 100644 index 00000000..1ab72c6f --- /dev/null +++ b/noao/onedspec/odcombine/srcwt/generic/xtimmap.x @@ -0,0 +1,1079 @@ +include <syserr.h> +include <error.h> +include <imhdr.h> +include <imset.h> +include <config.h> + +# The following is for compiling under V2.11. +define IM_BUFFRAC IM_BUFSIZE +include <imset.h> + +# These routines maintain an arbitrary number of indexed "open" images which +# must be READ_ONLY. The calling program may use the returned pointer for +# header accesses but must call xt_opix before I/O. Subsequent calls to +# xt_opix may invalidate the pointer. The xt_imunmap call will free memory. + +define MAX_OPENIM (LAST_FD-16) # Maximum images kept open +define MAX_OPENPIX 45 # Maximum pixel files kept open + +define XT_SZIMNAME 299 # Size of IMNAME string +define XT_LEN 179 # Structure length +define XT_IMNAME Memc[P2C($1)] # Image name +define XT_ARG Memi[$1+150] # IMMAP header argument +define XT_IM Memi[$1+151] # IMIO pointer +define XT_HDR Memi[$1+152] # Copy of IMIO pointer +define XT_CLOSEFD Memi[$1+153] # Close FD? +define XT_FLAG Memi[$1+154] # Flag +define XT_BUFSIZE Memi[$1+155] # Buffer size +define XT_BUF Memi[$1+156] # Data buffer +define XT_BTYPE Memi[$1+157] # Data buffer type +define XT_VS Memi[$1+157+$2] # Start vector (10) +define XT_VE Memi[$1+167+$2] # End vector (10) + +# Options +define XT_MAPUNMAP 1 # Map and unmap images. + +# XT_IMMAP -- Map an image and save it as an indexed open image. +# The returned pointer may be used for header access but not I/O. +# The indexed image is closed by xt_imunmap. + +pointer procedure xt_immap (imname, acmode, hdr_arg, index) + +char imname[ARB] #I Image name +int acmode #I Access mode +int hdr_arg #I Header argument +int index #I Save index +pointer im #O Image pointer (returned) + +int i, envgeti() +pointer xt, xt_opix() +errchk xt_opix + +int first_time +data first_time /YES/ + +include "../xtimmap.com" + +begin + if (acmode != READ_ONLY) + call error (1, "XT_IMMAP: Only READ_ONLY allowed") + + # Initialize once per process. + if (first_time == YES) { + iferr (option = envgeti ("imcombine_option")) + option = 1 + min_open = 1 + nopen = 0 + nopenpix = 0 + nalloc = MAX_OPENIM + call calloc (ims, nalloc, TY_POINTER) + first_time = NO + } + + # Free image if needed. + call xt_imunmap (NULL, index) + + # Allocate structure. + if (index > nalloc) { + i = nalloc + nalloc = index + MAX_OPENIM + call realloc (ims, nalloc, TY_STRUCT) + call amovki (NULL, Memi[ims+i], nalloc-i) + } + call calloc (xt, XT_LEN, TY_STRUCT) + Memi[ims+index-1] = xt + + # Initialize. + call strcpy (imname, XT_IMNAME(xt), XT_SZIMNAME) + XT_ARG(xt) = hdr_arg + XT_IM(xt) = NULL + XT_HDR(xt) = NULL + + # Open image. + last_flag = 0 + im = xt_opix (NULL, index, 0) + + # Make copy of IMIO pointer for header keyword access. + call malloc (XT_HDR(xt), LEN_IMDES+IM_HDRLEN(im)+1, TY_STRUCT) + call amovi (Memi[im], Memi[XT_HDR(xt)], LEN_IMDES) + call amovi (IM_MAGIC(im), IM_MAGIC(XT_HDR(xt)), IM_HDRLEN(im)+1) + + return (XT_HDR(xt)) +end + + +# XT_OPIX -- Open the image for I/O. +# If the image has not been mapped return the default pointer. + +pointer procedure xt_opix (imdef, index, flag) + +int index #I index +pointer imdef #I Default pointer +int flag #I Flag + +int i, open(), imstati() +pointer im, xt, xt1, immap() +errchk open, immap, imunmap + +include "../xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imdef) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Return pointer for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (im) + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= MAX_OPENIM) { + if (option == XT_MAPUNMAP || flag == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + if (!IS_INDEFI(XT_BUFSIZE(xt))) + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + else + XT_BUFSIZE(xt) = imstati (im, IM_BUFSIZE) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (im) +end + + +# XT_CPIX -- Close image. + +procedure xt_cpix (index) + +int index #I index + +pointer xt +errchk imunmap + +include "../xtimmap.com" + +begin + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + if (xt == NULL) + return + + if (XT_IM(xt) != NULL) { + call imunmap (XT_IM(xt)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt) == NO) + nopenpix = nopenpix - 1 + } + call mfree (XT_BUF(xt), XT_BTYPE(xt)) +end + + +# XT_IMSETI -- Set IMIO value. + +procedure xt_imseti (index, param, value) + +int index #I index +int param #I IMSET parameter +int value #I Value + +pointer xt +bool streq() + +include "../xtimmap.com" + +begin + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + if (xt == NULL) { + if (streq (param, "option")) + option = value + } else { + if (streq (param, "bufsize")) { + XT_BUFSIZE(xt) = value + if (XT_IM(xt) != NULL) { + call imseti (XT_IM(xt), IM_BUFFRAC, 0) + call imseti (XT_IM(xt), IM_BUFSIZE, value) + } + } + } +end + + +# XT_IMUNMAP -- Unmap indexed open image. +# The header pointer is set to NULL to indicate the image has been closed. + +procedure xt_imunmap (im, index) + +int im #U IMIO header pointer +int index #I index + +pointer xt +errchk imunmap + +include "../xtimmap.com" + +begin + # Check for an indexed image. If it is not unmap the pointer + # as a regular IMIO pointer. + + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + if (xt == NULL) { + if (im != NULL) + call imunmap (im) + return + } + + # Close indexed image. + if (XT_IM(xt) != NULL) { + iferr (call imunmap (XT_IM(xt))) { + XT_IM(xt) = NULL + call erract (EA_WARN) + } + nopen = nopen - 1 + if (XT_CLOSEFD(xt) == NO) + nopenpix = nopenpix - 1 + if (index == min_open) + min_open = 1 + } + + # Free any buffered memory. + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + + # Free header pointer. Note that if the supplied pointer is not + # header pointer then it is not set to NULL. + if (XT_HDR(xt) == im) + im = NULL + call mfree (XT_HDR(xt), TY_STRUCT) + + # Free save structure. + call mfree (Memi[ims+index-1], TY_STRUCT) +end + + +# XT_REINDEX -- Reindex open images. +# This is used when some images are closed by xt_imunmap. It is up to +# the calling program to reindex the header pointers and to subsequently +# use the new index values. + +procedure xt_reindex () + +int old, new + +include "../xtimmap.com" + +begin + new = 0 + do old = 0, nalloc-1 { + if (Memi[ims+old] == NULL) + next + Memi[ims+new] = Memi[ims+old] + new = new + 1 + } + do old = new, nalloc-1 + Memi[ims+old] = NULL +end + + + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnls (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnls(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggss() +errchk open, immap, imgnls, imggss, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "../xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnls (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnls (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_SHORT) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= MAX_OPENIM) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_SHORT) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_SHORT + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggss (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovs (Mems[ptr], Mems[XT_BUF(xt1)], nl*nc) + } + + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnls (im, buf, v)) +end + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnli (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnli(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggsi() +errchk open, immap, imgnli, imggsi, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "../xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnli (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnli (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_INT) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= MAX_OPENIM) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_INT) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_INT + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggsi (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovi (Memi[ptr], Memi[XT_BUF(xt1)], nl*nc) + } + + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnli (im, buf, v)) +end + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnlr (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnlr(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggsr() +errchk open, immap, imgnlr, imggsr, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "../xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnlr (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnlr (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_REAL) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= MAX_OPENIM) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_REAL) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_REAL + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggsr (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovr (Memr[ptr], Memr[XT_BUF(xt1)], nl*nc) + } + + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnlr (im, buf, v)) +end + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnld (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnld(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggsd() +errchk open, immap, imgnld, imggsd, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "../xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnld (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnld (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_DOUBLE) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= MAX_OPENIM) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_DOUBLE) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_DOUBLE + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggsd (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovd (Memd[ptr], Memd[XT_BUF(xt1)], nl*nc) + } + + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnld (im, buf, v)) +end + |