diff options
author | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
---|---|---|
committer | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
commit | fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch) | |
tree | bdda434976bc09c864f2e4fa6f16ba1952b1e555 /sys/vops/lz | |
download | iraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz |
Initial commit
Diffstat (limited to 'sys/vops/lz')
322 files changed, 8057 insertions, 0 deletions
diff --git a/sys/vops/lz/alani.x b/sys/vops/lz/alani.x new file mode 100644 index 00000000..28fb324e --- /dev/null +++ b/sys/vops/lz/alani.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALAN -- Compute the logical AND of two vectors (generic). The logical +# output value is returned as an int. + +procedure alani (a, b, c, npix) + +int a[ARB], b[ARB] +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 && b[i] != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alanki.x b/sys/vops/lz/alanki.x new file mode 100644 index 00000000..a5523400 --- /dev/null +++ b/sys/vops/lz/alanki.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALANK -- Compute the logical AND of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alanki (a, b, c, npix) + +int a[ARB], b +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 && b != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alankl.x b/sys/vops/lz/alankl.x new file mode 100644 index 00000000..b223303c --- /dev/null +++ b/sys/vops/lz/alankl.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALANK -- Compute the logical AND of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alankl (a, b, c, npix) + +long a[ARB], b +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 && b != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alanks.x b/sys/vops/lz/alanks.x new file mode 100644 index 00000000..f63e0371 --- /dev/null +++ b/sys/vops/lz/alanks.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALANK -- Compute the logical AND of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alanks (a, b, c, npix) + +short a[ARB], b +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 && b != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alanl.x b/sys/vops/lz/alanl.x new file mode 100644 index 00000000..b06304bd --- /dev/null +++ b/sys/vops/lz/alanl.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALAN -- Compute the logical AND of two vectors (generic). The logical +# output value is returned as an int. + +procedure alanl (a, b, c, npix) + +long a[ARB], b[ARB] +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 && b[i] != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alans.x b/sys/vops/lz/alans.x new file mode 100644 index 00000000..b2ff25c5 --- /dev/null +++ b/sys/vops/lz/alans.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALAN -- Compute the logical AND of two vectors (generic). The logical +# output value is returned as an int. + +procedure alans (a, b, c, npix) + +short a[ARB], b[ARB] +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 && b[i] != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alimc.x b/sys/vops/lz/alimc.x new file mode 100644 index 00000000..6f05be93 --- /dev/null +++ b/sys/vops/lz/alimc.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure alimc (a, npix, minval, maxval) + +char a[ARB], minval, maxval, value +int npix, i + +begin + minval = a[1] + maxval = a[1] + + do i = 1, npix { + value = a[i] + if (value < minval) + minval = value + else if (value > maxval) + maxval = value + } +end diff --git a/sys/vops/lz/alimd.x b/sys/vops/lz/alimd.x new file mode 100644 index 00000000..2e56673d --- /dev/null +++ b/sys/vops/lz/alimd.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure alimd (a, npix, minval, maxval) + +double a[ARB], minval, maxval, value +int npix, i + +begin + minval = a[1] + maxval = a[1] + + do i = 1, npix { + value = a[i] + if (value < minval) + minval = value + else if (value > maxval) + maxval = value + } +end diff --git a/sys/vops/lz/alimi.x b/sys/vops/lz/alimi.x new file mode 100644 index 00000000..0a043976 --- /dev/null +++ b/sys/vops/lz/alimi.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure alimi (a, npix, minval, maxval) + +int a[ARB], minval, maxval, value +int npix, i + +begin + minval = a[1] + maxval = a[1] + + do i = 1, npix { + value = a[i] + if (value < minval) + minval = value + else if (value > maxval) + maxval = value + } +end diff --git a/sys/vops/lz/aliml.x b/sys/vops/lz/aliml.x new file mode 100644 index 00000000..abbad1c5 --- /dev/null +++ b/sys/vops/lz/aliml.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure aliml (a, npix, minval, maxval) + +long a[ARB], minval, maxval, value +int npix, i + +begin + minval = a[1] + maxval = a[1] + + do i = 1, npix { + value = a[i] + if (value < minval) + minval = value + else if (value > maxval) + maxval = value + } +end diff --git a/sys/vops/lz/alimr.x b/sys/vops/lz/alimr.x new file mode 100644 index 00000000..6845f36c --- /dev/null +++ b/sys/vops/lz/alimr.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure alimr (a, npix, minval, maxval) + +real a[ARB], minval, maxval, value +int npix, i + +begin + minval = a[1] + maxval = a[1] + + do i = 1, npix { + value = a[i] + if (value < minval) + minval = value + else if (value > maxval) + maxval = value + } +end diff --git a/sys/vops/lz/alims.x b/sys/vops/lz/alims.x new file mode 100644 index 00000000..71d5c498 --- /dev/null +++ b/sys/vops/lz/alims.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure alims (a, npix, minval, maxval) + +short a[ARB], minval, maxval, value +int npix, i + +begin + minval = a[1] + maxval = a[1] + + do i = 1, npix { + value = a[i] + if (value < minval) + minval = value + else if (value > maxval) + maxval = value + } +end diff --git a/sys/vops/lz/alimx.x b/sys/vops/lz/alimx.x new file mode 100644 index 00000000..93a7fe61 --- /dev/null +++ b/sys/vops/lz/alimx.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALIM -- Compute the limits (minimum and maximum values) of a vector. + +procedure alimx (a, npix, minval, maxval) + +complex a[ARB], minval, maxval, value +int npix, i + +begin + minval = a[1] + maxval = a[1] + + do i = 1, npix { + value = a[i] + if (abs(value) < abs(minval)) + minval = value + else if (abs(value) > abs(maxval)) + maxval = value + } +end diff --git a/sys/vops/lz/allnd.x b/sys/vops/lz/allnd.x new file mode 100644 index 00000000..82ae72bd --- /dev/null +++ b/sys/vops/lz/allnd.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALLN -- Compute the natural logarithm of a vector (generic). If the natural +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the pixel value to be returned. + +procedure allnd (a, b, npix, errfcn) + +double a[ARB], b[ARB] +int npix, i +extern errfcn() +double errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0.0D0) + b[i] = errfcn (a[i]) + else { + b[i] = log (a[i]) + } + } +end diff --git a/sys/vops/lz/allni.x b/sys/vops/lz/allni.x new file mode 100644 index 00000000..9dc1bf4a --- /dev/null +++ b/sys/vops/lz/allni.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALLN -- Compute the natural logarithm of a vector (generic). If the natural +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the pixel value to be returned. + +procedure allni (a, b, npix, errfcn) + +int a[ARB], b[ARB] +int npix, i +extern errfcn() +int errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0) + b[i] = errfcn (a[i]) + else { + b[i] = log (real (a[i])) + } + } +end diff --git a/sys/vops/lz/allnl.x b/sys/vops/lz/allnl.x new file mode 100644 index 00000000..afc1a62e --- /dev/null +++ b/sys/vops/lz/allnl.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALLN -- Compute the natural logarithm of a vector (generic). If the natural +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the pixel value to be returned. + +procedure allnl (a, b, npix, errfcn) + +long a[ARB], b[ARB] +int npix, i +extern errfcn() +long errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0) + b[i] = errfcn (a[i]) + else { + b[i] = log (double (a[i])) + } + } +end diff --git a/sys/vops/lz/allnr.x b/sys/vops/lz/allnr.x new file mode 100644 index 00000000..469ce448 --- /dev/null +++ b/sys/vops/lz/allnr.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALLN -- Compute the natural logarithm of a vector (generic). If the natural +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the pixel value to be returned. + +procedure allnr (a, b, npix, errfcn) + +real a[ARB], b[ARB] +int npix, i +extern errfcn() +real errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0.0) + b[i] = errfcn (a[i]) + else { + b[i] = log (a[i]) + } + } +end diff --git a/sys/vops/lz/allns.x b/sys/vops/lz/allns.x new file mode 100644 index 00000000..3d968186 --- /dev/null +++ b/sys/vops/lz/allns.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALLN -- Compute the natural logarithm of a vector (generic). If the natural +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the pixel value to be returned. + +procedure allns (a, b, npix, errfcn) + +short a[ARB], b[ARB] +int npix, i +extern errfcn() +short errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0) + b[i] = errfcn (a[i]) + else { + b[i] = log (real (a[i])) + } + } +end diff --git a/sys/vops/lz/allnx.x b/sys/vops/lz/allnx.x new file mode 100644 index 00000000..b4527117 --- /dev/null +++ b/sys/vops/lz/allnx.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALLN -- Compute the natural logarithm of a vector (generic). If the natural +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the pixel value to be returned. + +procedure allnx (a, b, npix, errfcn) + +complex a[ARB], b[ARB] +int npix, i +extern errfcn() +complex errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] == (0.0,0.0)) + b[i] = errfcn (a[i]) + else { + b[i] = log (a[i]) + } + } +end diff --git a/sys/vops/lz/alogd.x b/sys/vops/lz/alogd.x new file mode 100644 index 00000000..b5f7b78f --- /dev/null +++ b/sys/vops/lz/alogd.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOG -- Compute the logarithm to the base 10 of a vector (generic). If the +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the function value. + +procedure alogd (a, b, npix, errfcn) + +double a[ARB], b[ARB] +int npix, i +extern errfcn() +double errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0.0D0) + b[i] = errfcn (a[i]) + else { + # Note Fortran standard forbids log10(cplx). + b[i] = log10 (a[i]) + } + } +end diff --git a/sys/vops/lz/alogi.x b/sys/vops/lz/alogi.x new file mode 100644 index 00000000..294289c5 --- /dev/null +++ b/sys/vops/lz/alogi.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOG -- Compute the logarithm to the base 10 of a vector (generic). If the +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the function value. + +procedure alogi (a, b, npix, errfcn) + +int a[ARB], b[ARB] +int npix, i +extern errfcn() +int errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0) + b[i] = errfcn (a[i]) + else { + # Note Fortran standard forbids log10(cplx). + b[i] = log10 (real (a[i])) + } + } +end diff --git a/sys/vops/lz/alogl.x b/sys/vops/lz/alogl.x new file mode 100644 index 00000000..1af0e2f5 --- /dev/null +++ b/sys/vops/lz/alogl.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOG -- Compute the logarithm to the base 10 of a vector (generic). If the +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the function value. + +procedure alogl (a, b, npix, errfcn) + +long a[ARB], b[ARB] +int npix, i +extern errfcn() +long errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0) + b[i] = errfcn (a[i]) + else { + # Note Fortran standard forbids log10(cplx). + b[i] = log10 (double (a[i])) + } + } +end diff --git a/sys/vops/lz/alogr.x b/sys/vops/lz/alogr.x new file mode 100644 index 00000000..049f7cc7 --- /dev/null +++ b/sys/vops/lz/alogr.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOG -- Compute the logarithm to the base 10 of a vector (generic). If the +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the function value. + +procedure alogr (a, b, npix, errfcn) + +real a[ARB], b[ARB] +int npix, i +extern errfcn() +real errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0.0) + b[i] = errfcn (a[i]) + else { + # Note Fortran standard forbids log10(cplx). + b[i] = log10 (a[i]) + } + } +end diff --git a/sys/vops/lz/alogs.x b/sys/vops/lz/alogs.x new file mode 100644 index 00000000..861185a5 --- /dev/null +++ b/sys/vops/lz/alogs.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOG -- Compute the logarithm to the base 10 of a vector (generic). If the +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the function value. + +procedure alogs (a, b, npix, errfcn) + +short a[ARB], b[ARB] +int npix, i +extern errfcn() +short errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] <= 0) + b[i] = errfcn (a[i]) + else { + # Note Fortran standard forbids log10(cplx). + b[i] = log10 (real (a[i])) + } + } +end diff --git a/sys/vops/lz/alogx.x b/sys/vops/lz/alogx.x new file mode 100644 index 00000000..adb78cc6 --- /dev/null +++ b/sys/vops/lz/alogx.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOG -- Compute the logarithm to the base 10 of a vector (generic). If the +# logarithm is undefined (x <= 0) a user supplied function is called to get +# the function value. + +procedure alogx (a, b, npix, errfcn) + +complex a[ARB], b[ARB] +int npix, i +extern errfcn() +complex errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] == (0.0,0.0)) + b[i] = errfcn (a[i]) + else { + # Note Fortran standard forbids log10(cplx). + b[i] = log10 (real (a[i])) + } + } +end diff --git a/sys/vops/lz/alori.x b/sys/vops/lz/alori.x new file mode 100644 index 00000000..07fefc59 --- /dev/null +++ b/sys/vops/lz/alori.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOR -- Compute the logical OR of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alori (a, b, c, npix) + +int a[ARB], b[ARB] +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 || b[i] != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alorki.x b/sys/vops/lz/alorki.x new file mode 100644 index 00000000..1fa2089e --- /dev/null +++ b/sys/vops/lz/alorki.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALORK -- Compute the logical OR of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alorki (a, b, c, npix) + +int a[ARB], b +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 || b != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alorkl.x b/sys/vops/lz/alorkl.x new file mode 100644 index 00000000..eedcb247 --- /dev/null +++ b/sys/vops/lz/alorkl.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALORK -- Compute the logical OR of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alorkl (a, b, c, npix) + +long a[ARB], b +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 || b != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alorks.x b/sys/vops/lz/alorks.x new file mode 100644 index 00000000..a38924c9 --- /dev/null +++ b/sys/vops/lz/alorks.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALORK -- Compute the logical OR of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alorks (a, b, c, npix) + +short a[ARB], b +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 || b != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alorl.x b/sys/vops/lz/alorl.x new file mode 100644 index 00000000..bd23bcb1 --- /dev/null +++ b/sys/vops/lz/alorl.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOR -- Compute the logical OR of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alorl (a, b, c, npix) + +long a[ARB], b[ARB] +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 || b[i] != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alors.x b/sys/vops/lz/alors.x new file mode 100644 index 00000000..a87c5915 --- /dev/null +++ b/sys/vops/lz/alors.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOR -- Compute the logical OR of a vector and a constant (generic). +# The logical output value is returned as an int. + +procedure alors (a, b, c, npix) + +short a[ARB], b[ARB] +int c[ARB] + +int npix, i + +begin + do i = 1, npix + if (a[i] != 0 || b[i] != 0) + c[i] = YES + else + c[i] = NO +end diff --git a/sys/vops/lz/alovc.x b/sys/vops/lz/alovc.x new file mode 100644 index 00000000..39b5ff34 --- /dev/null +++ b/sys/vops/lz/alovc.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOV -- Compute the low value (minimum) of a vector. + +char procedure alovc (a, npix) + +char a[ARB] +int npix +char low, pixval +int i + +begin + low = a[1] + + do i = 1, npix { + pixval = a[i] + if (pixval < low) + low = pixval + } + + return (low) +end diff --git a/sys/vops/lz/alovd.x b/sys/vops/lz/alovd.x new file mode 100644 index 00000000..e5de175b --- /dev/null +++ b/sys/vops/lz/alovd.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOV -- Compute the low value (minimum) of a vector. + +double procedure alovd (a, npix) + +double a[ARB] +int npix +double low, pixval +int i + +begin + low = a[1] + + do i = 1, npix { + pixval = a[i] + if (pixval < low) + low = pixval + } + + return (low) +end diff --git a/sys/vops/lz/alovi.x b/sys/vops/lz/alovi.x new file mode 100644 index 00000000..f2045c11 --- /dev/null +++ b/sys/vops/lz/alovi.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOV -- Compute the low value (minimum) of a vector. + +int procedure alovi (a, npix) + +int a[ARB] +int npix +int low, pixval +int i + +begin + low = a[1] + + do i = 1, npix { + pixval = a[i] + if (pixval < low) + low = pixval + } + + return (low) +end diff --git a/sys/vops/lz/alovl.x b/sys/vops/lz/alovl.x new file mode 100644 index 00000000..9fcf4f6d --- /dev/null +++ b/sys/vops/lz/alovl.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOV -- Compute the low value (minimum) of a vector. + +long procedure alovl (a, npix) + +long a[ARB] +int npix +long low, pixval +int i + +begin + low = a[1] + + do i = 1, npix { + pixval = a[i] + if (pixval < low) + low = pixval + } + + return (low) +end diff --git a/sys/vops/lz/alovr.x b/sys/vops/lz/alovr.x new file mode 100644 index 00000000..87e08917 --- /dev/null +++ b/sys/vops/lz/alovr.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOV -- Compute the low value (minimum) of a vector. + +real procedure alovr (a, npix) + +real a[ARB] +int npix +real low, pixval +int i + +begin + low = a[1] + + do i = 1, npix { + pixval = a[i] + if (pixval < low) + low = pixval + } + + return (low) +end diff --git a/sys/vops/lz/alovs.x b/sys/vops/lz/alovs.x new file mode 100644 index 00000000..30a83bed --- /dev/null +++ b/sys/vops/lz/alovs.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOV -- Compute the low value (minimum) of a vector. + +short procedure alovs (a, npix) + +short a[ARB] +int npix +short low, pixval +int i + +begin + low = a[1] + + do i = 1, npix { + pixval = a[i] + if (pixval < low) + low = pixval + } + + return (low) +end diff --git a/sys/vops/lz/alovx.x b/sys/vops/lz/alovx.x new file mode 100644 index 00000000..c0d17deb --- /dev/null +++ b/sys/vops/lz/alovx.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALOV -- Compute the low value (minimum) of a vector. + +complex procedure alovx (a, npix) + +complex a[ARB] +int npix +complex low, pixval +real abs_low +int i + +begin + low = a[1] + abs_low = abs (low) + + do i = 1, npix { + pixval = a[i] + if (abs (pixval) < abs_low) { + low = pixval + abs_low = abs (low) + } + } + + return (low) +end diff --git a/sys/vops/lz/altad.x b/sys/vops/lz/altad.x new file mode 100644 index 00000000..05fca620 --- /dev/null +++ b/sys/vops/lz/altad.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTA -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] + k1) * k2 + +procedure altad (a, b, npix, k1, k2) + +double a[ARB], b[ARB] +double k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 +end diff --git a/sys/vops/lz/altai.x b/sys/vops/lz/altai.x new file mode 100644 index 00000000..62576263 --- /dev/null +++ b/sys/vops/lz/altai.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTA -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] + k1) * k2 + +procedure altai (a, b, npix, k1, k2) + +int a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 +end diff --git a/sys/vops/lz/altal.x b/sys/vops/lz/altal.x new file mode 100644 index 00000000..d95ca1f4 --- /dev/null +++ b/sys/vops/lz/altal.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTA -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] + k1) * k2 + +procedure altal (a, b, npix, k1, k2) + +long a[ARB], b[ARB] +double k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 +end diff --git a/sys/vops/lz/altar.x b/sys/vops/lz/altar.x new file mode 100644 index 00000000..031be04d --- /dev/null +++ b/sys/vops/lz/altar.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTA -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] + k1) * k2 + +procedure altar (a, b, npix, k1, k2) + +real a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 +end diff --git a/sys/vops/lz/altas.x b/sys/vops/lz/altas.x new file mode 100644 index 00000000..7b59d86b --- /dev/null +++ b/sys/vops/lz/altas.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTA -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] + k1) * k2 + +procedure altas (a, b, npix, k1, k2) + +short a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 +end diff --git a/sys/vops/lz/altax.x b/sys/vops/lz/altax.x new file mode 100644 index 00000000..7d71e97d --- /dev/null +++ b/sys/vops/lz/altax.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTA -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] + k1) * k2 + +procedure altax (a, b, npix, k1, k2) + +complex a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 +end diff --git a/sys/vops/lz/altmd.x b/sys/vops/lz/altmd.x new file mode 100644 index 00000000..c8a7296b --- /dev/null +++ b/sys/vops/lz/altmd.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTM -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] * k1) + k2 + +procedure altmd (a, b, npix, k1, k2) + +double a[ARB], b[ARB] +double k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] * k1) + k2 +end diff --git a/sys/vops/lz/altmi.x b/sys/vops/lz/altmi.x new file mode 100644 index 00000000..64cb93c4 --- /dev/null +++ b/sys/vops/lz/altmi.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTM -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] * k1) + k2 + +procedure altmi (a, b, npix, k1, k2) + +int a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] * k1) + k2 +end diff --git a/sys/vops/lz/altml.x b/sys/vops/lz/altml.x new file mode 100644 index 00000000..a9727472 --- /dev/null +++ b/sys/vops/lz/altml.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTM -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] * k1) + k2 + +procedure altml (a, b, npix, k1, k2) + +long a[ARB], b[ARB] +double k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] * k1) + k2 +end diff --git a/sys/vops/lz/altmr.x b/sys/vops/lz/altmr.x new file mode 100644 index 00000000..a088b75d --- /dev/null +++ b/sys/vops/lz/altmr.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTM -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] * k1) + k2 + +procedure altmr (a, b, npix, k1, k2) + +real a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] * k1) + k2 +end diff --git a/sys/vops/lz/altms.x b/sys/vops/lz/altms.x new file mode 100644 index 00000000..292db9dc --- /dev/null +++ b/sys/vops/lz/altms.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTM -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] * k1) + k2 + +procedure altms (a, b, npix, k1, k2) + +short a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] * k1) + k2 +end diff --git a/sys/vops/lz/altmx.x b/sys/vops/lz/altmx.x new file mode 100644 index 00000000..fca0e274 --- /dev/null +++ b/sys/vops/lz/altmx.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTM -- Linearly map a vector into another vector of the same datatype. +# b[i] = (a[i] * k1) + k2 + +procedure altmx (a, b, npix, k1, k2) + +complex a[ARB], b[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] * k1) + k2 +end diff --git a/sys/vops/lz/altrd.x b/sys/vops/lz/altrd.x new file mode 100644 index 00000000..57e877b0 --- /dev/null +++ b/sys/vops/lz/altrd.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTR -- Linearly map a vector into another vector of the same datatype. +# This is the most general form. See also ALTA and ALTM. +# b[i] = (a[i] + k1) * k2 + k3 + +procedure altrd (a, b, npix, k1, k2, k3) + +double a[ARB], b[ARB] +double k1, k2, k3 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 + k3 +end diff --git a/sys/vops/lz/altri.x b/sys/vops/lz/altri.x new file mode 100644 index 00000000..5ef70e85 --- /dev/null +++ b/sys/vops/lz/altri.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTR -- Linearly map a vector into another vector of the same datatype. +# This is the most general form. See also ALTA and ALTM. +# b[i] = (a[i] + k1) * k2 + k3 + +procedure altri (a, b, npix, k1, k2, k3) + +int a[ARB], b[ARB] +real k1, k2, k3 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 + k3 +end diff --git a/sys/vops/lz/altrl.x b/sys/vops/lz/altrl.x new file mode 100644 index 00000000..7c3d48b8 --- /dev/null +++ b/sys/vops/lz/altrl.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTR -- Linearly map a vector into another vector of the same datatype. +# This is the most general form. See also ALTA and ALTM. +# b[i] = (a[i] + k1) * k2 + k3 + +procedure altrl (a, b, npix, k1, k2, k3) + +long a[ARB], b[ARB] +double k1, k2, k3 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 + k3 +end diff --git a/sys/vops/lz/altrr.x b/sys/vops/lz/altrr.x new file mode 100644 index 00000000..f78522f5 --- /dev/null +++ b/sys/vops/lz/altrr.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTR -- Linearly map a vector into another vector of the same datatype. +# This is the most general form. See also ALTA and ALTM. +# b[i] = (a[i] + k1) * k2 + k3 + +procedure altrr (a, b, npix, k1, k2, k3) + +real a[ARB], b[ARB] +real k1, k2, k3 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 + k3 +end diff --git a/sys/vops/lz/altrs.x b/sys/vops/lz/altrs.x new file mode 100644 index 00000000..50458a82 --- /dev/null +++ b/sys/vops/lz/altrs.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTR -- Linearly map a vector into another vector of the same datatype. +# This is the most general form. See also ALTA and ALTM. +# b[i] = (a[i] + k1) * k2 + k3 + +procedure altrs (a, b, npix, k1, k2, k3) + +short a[ARB], b[ARB] +real k1, k2, k3 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 + k3 +end diff --git a/sys/vops/lz/altrx.x b/sys/vops/lz/altrx.x new file mode 100644 index 00000000..d23ad236 --- /dev/null +++ b/sys/vops/lz/altrx.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALTR -- Linearly map a vector into another vector of the same datatype. +# This is the most general form. See also ALTA and ALTM. +# b[i] = (a[i] + k1) * k2 + k3 + +procedure altrx (a, b, npix, k1, k2, k3) + +complex a[ARB], b[ARB] +real k1, k2, k3 +int npix, i + +begin + do i = 1, npix + b[i] = (a[i] + k1) * k2 + k3 +end diff --git a/sys/vops/lz/aluid.x b/sys/vops/lz/aluid.x new file mode 100644 index 00000000..d529ba77 --- /dev/null +++ b/sys/vops/lz/aluid.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ALUI -- Vector lookup and interpolate (linear). B[i] = A(X[i]). +# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional +# part) is recognized and will not cause a reference off the right end of the +# array. This is done in a way which will also cause execution to be faster +# when the sample points are integral, i.e., fall exactly on data points in +# the input array. + +procedure aluid (a, b, x, npix) + +double a[ARB], b[ARB] +real x[ARB], fraction, tol +int npix, i, left_pixel + +begin + tol = EPSILONR * 5.0 + + do i = 1, npix { + left_pixel = int (x[i]) + fraction = x[i] - real(left_pixel) + if (fraction < tol) + b[i] = a[left_pixel] + else + b[i] = a[left_pixel] * (1.0 - fraction) + + a[left_pixel+1] * fraction + } +end diff --git a/sys/vops/lz/aluii.x b/sys/vops/lz/aluii.x new file mode 100644 index 00000000..67d63575 --- /dev/null +++ b/sys/vops/lz/aluii.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ALUI -- Vector lookup and interpolate (linear). B[i] = A(X[i]). +# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional +# part) is recognized and will not cause a reference off the right end of the +# array. This is done in a way which will also cause execution to be faster +# when the sample points are integral, i.e., fall exactly on data points in +# the input array. + +procedure aluii (a, b, x, npix) + +int a[ARB], b[ARB] +real x[ARB], fraction, tol +int npix, i, left_pixel + +begin + tol = EPSILONR * 5.0 + + do i = 1, npix { + left_pixel = int (x[i]) + fraction = x[i] - real(left_pixel) + if (fraction < tol) + b[i] = a[left_pixel] + else + b[i] = a[left_pixel] * (1.0 - fraction) + + a[left_pixel+1] * fraction + } +end diff --git a/sys/vops/lz/aluil.x b/sys/vops/lz/aluil.x new file mode 100644 index 00000000..177fb4e6 --- /dev/null +++ b/sys/vops/lz/aluil.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ALUI -- Vector lookup and interpolate (linear). B[i] = A(X[i]). +# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional +# part) is recognized and will not cause a reference off the right end of the +# array. This is done in a way which will also cause execution to be faster +# when the sample points are integral, i.e., fall exactly on data points in +# the input array. + +procedure aluil (a, b, x, npix) + +long a[ARB], b[ARB] +real x[ARB], fraction, tol +int npix, i, left_pixel + +begin + tol = EPSILONR * 5.0 + + do i = 1, npix { + left_pixel = int (x[i]) + fraction = x[i] - real(left_pixel) + if (fraction < tol) + b[i] = a[left_pixel] + else + b[i] = a[left_pixel] * (1.0 - fraction) + + a[left_pixel+1] * fraction + } +end diff --git a/sys/vops/lz/aluir.x b/sys/vops/lz/aluir.x new file mode 100644 index 00000000..33ef1e4b --- /dev/null +++ b/sys/vops/lz/aluir.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ALUI -- Vector lookup and interpolate (linear). B[i] = A(X[i]). +# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional +# part) is recognized and will not cause a reference off the right end of the +# array. This is done in a way which will also cause execution to be faster +# when the sample points are integral, i.e., fall exactly on data points in +# the input array. + +procedure aluir (a, b, x, npix) + +real a[ARB], b[ARB] +real x[ARB], fraction, tol +int npix, i, left_pixel + +begin + tol = EPSILONR * 5.0 + + do i = 1, npix { + left_pixel = int (x[i]) + fraction = x[i] - real(left_pixel) + if (fraction < tol) + b[i] = a[left_pixel] + else + b[i] = a[left_pixel] * (1.0 - fraction) + + a[left_pixel+1] * fraction + } +end diff --git a/sys/vops/lz/aluis.x b/sys/vops/lz/aluis.x new file mode 100644 index 00000000..d64dfa1a --- /dev/null +++ b/sys/vops/lz/aluis.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ALUI -- Vector lookup and interpolate (linear). B[i] = A(X[i]). +# No bounds checking is performed, but the case A(X[i])=NPIX (no fractional +# part) is recognized and will not cause a reference off the right end of the +# array. This is done in a way which will also cause execution to be faster +# when the sample points are integral, i.e., fall exactly on data points in +# the input array. + +procedure aluis (a, b, x, npix) + +short a[ARB], b[ARB] +real x[ARB], fraction, tol +int npix, i, left_pixel + +begin + tol = EPSILONR * 5.0 + + do i = 1, npix { + left_pixel = int (x[i]) + fraction = x[i] - real(left_pixel) + if (fraction < tol) + b[i] = a[left_pixel] + else + b[i] = a[left_pixel] * (1.0 - fraction) + + a[left_pixel+1] * fraction + } +end diff --git a/sys/vops/lz/alutc.x b/sys/vops/lz/alutc.x new file mode 100644 index 00000000..06d753fe --- /dev/null +++ b/sys/vops/lz/alutc.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALUT -- Map an array using table lookup. Note that an input value of zero +# indexes the first element of the lookup table. No bounds checking is +# performed. + +procedure alutc (a, b, npix, lut) + +char a[ARB] + +char b[ARB] # output data array +char lut[ARB] # lookup table +int npix, i + +begin + do i = 1, npix + b[i] = lut[a[i]+1] +end diff --git a/sys/vops/lz/alutd.x b/sys/vops/lz/alutd.x new file mode 100644 index 00000000..d1e22aea --- /dev/null +++ b/sys/vops/lz/alutd.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALUT -- Map an array using table lookup. Note that an input value of zero +# indexes the first element of the lookup table. No bounds checking is +# performed. + +procedure alutd (a, b, npix, lut) + +int a[ARB] # input array of indices + +double b[ARB] # output data array +double lut[ARB] # lookup table +int npix, i + +begin + do i = 1, npix + b[i] = lut[a[i]+1] +end diff --git a/sys/vops/lz/aluti.x b/sys/vops/lz/aluti.x new file mode 100644 index 00000000..ba3099b3 --- /dev/null +++ b/sys/vops/lz/aluti.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALUT -- Map an array using table lookup. Note that an input value of zero +# indexes the first element of the lookup table. No bounds checking is +# performed. + +procedure aluti (a, b, npix, lut) + +int a[ARB] + +int b[ARB] # output data array +int lut[ARB] # lookup table +int npix, i + +begin + do i = 1, npix + b[i] = lut[a[i]+1] +end diff --git a/sys/vops/lz/alutl.x b/sys/vops/lz/alutl.x new file mode 100644 index 00000000..ccc95ab5 --- /dev/null +++ b/sys/vops/lz/alutl.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALUT -- Map an array using table lookup. Note that an input value of zero +# indexes the first element of the lookup table. No bounds checking is +# performed. + +procedure alutl (a, b, npix, lut) + +long a[ARB] + +long b[ARB] # output data array +long lut[ARB] # lookup table +int npix, i + +begin + do i = 1, npix + b[i] = lut[a[i]+1] +end diff --git a/sys/vops/lz/alutr.x b/sys/vops/lz/alutr.x new file mode 100644 index 00000000..a72cc11f --- /dev/null +++ b/sys/vops/lz/alutr.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALUT -- Map an array using table lookup. Note that an input value of zero +# indexes the first element of the lookup table. No bounds checking is +# performed. + +procedure alutr (a, b, npix, lut) + +int a[ARB] # input array of indices + +real b[ARB] # output data array +real lut[ARB] # lookup table +int npix, i + +begin + do i = 1, npix + b[i] = lut[a[i]+1] +end diff --git a/sys/vops/lz/aluts.x b/sys/vops/lz/aluts.x new file mode 100644 index 00000000..8af08735 --- /dev/null +++ b/sys/vops/lz/aluts.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ALUT -- Map an array using table lookup. Note that an input value of zero +# indexes the first element of the lookup table. No bounds checking is +# performed. + +procedure aluts (a, b, npix, lut) + +short a[ARB] + +short b[ARB] # output data array +short lut[ARB] # lookup table +int npix, i + +begin + do i = 1, npix + b[i] = lut[a[i]+1] +end diff --git a/sys/vops/lz/amagd.x b/sys/vops/lz/amagd.x new file mode 100644 index 00000000..d4238cfd --- /dev/null +++ b/sys/vops/lz/amagd.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAG -- Return the magnitude of two vectors. + +procedure amagd (a, b, c, npix) + +double a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = sqrt (double(a[i] ** 2) + double(b[i] ** 2)) +end diff --git a/sys/vops/lz/amagi.x b/sys/vops/lz/amagi.x new file mode 100644 index 00000000..9bddef17 --- /dev/null +++ b/sys/vops/lz/amagi.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAG -- Return the magnitude of two vectors. + +procedure amagi (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = sqrt (real(a[i] ** 2) + real(b[i] ** 2)) +end diff --git a/sys/vops/lz/amagl.x b/sys/vops/lz/amagl.x new file mode 100644 index 00000000..31fd69a0 --- /dev/null +++ b/sys/vops/lz/amagl.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAG -- Return the magnitude of two vectors. + +procedure amagl (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = sqrt (double(a[i] ** 2) + double(b[i] ** 2)) +end diff --git a/sys/vops/lz/amagr.x b/sys/vops/lz/amagr.x new file mode 100644 index 00000000..2db3c085 --- /dev/null +++ b/sys/vops/lz/amagr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAG -- Return the magnitude of two vectors. + +procedure amagr (a, b, c, npix) + +real a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = sqrt (real(a[i] ** 2) + real(b[i] ** 2)) +end diff --git a/sys/vops/lz/amags.x b/sys/vops/lz/amags.x new file mode 100644 index 00000000..7f86bc75 --- /dev/null +++ b/sys/vops/lz/amags.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAG -- Return the magnitude of two vectors. + +procedure amags (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = sqrt (real(a[i] ** 2) + real(b[i] ** 2)) +end diff --git a/sys/vops/lz/amagx.x b/sys/vops/lz/amagx.x new file mode 100644 index 00000000..2319394d --- /dev/null +++ b/sys/vops/lz/amagx.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAG -- Return the magnitude of two vectors. + +procedure amagx (a, b, c, npix) + +complex a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = sqrt (a[i] ** 2 + b[i] ** 2) +end diff --git a/sys/vops/lz/amapd.x b/sys/vops/lz/amapd.x new file mode 100644 index 00000000..8f766793 --- /dev/null +++ b/sys/vops/lz/amapd.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAP -- Vector linear transformation. Map the range of pixel values +# a1,a2 from a into the range b1,b2 in b. It is assumed that a1 < a2 +# and b1 < b2. + +procedure amapd (a, b, npix, a1, a2, b1, b2) + +double a[ARB], b[ARB] +double a1, a2, b1, b2 + +double minout, maxout, aoff, boff, pixval + +double scalar + +int npix, i + +begin + scalar = (double (b2) - double (b1)) / (double (a2) - double (a1)) + + minout = min (b1, b2) + maxout = max (b1, b2) + aoff = a1 + boff = b1 + + do i = 1, npix { + pixval = (a[i] - aoff) * scalar + b[i] = max(minout, min(maxout, pixval + boff)) + } +end diff --git a/sys/vops/lz/amapi.x b/sys/vops/lz/amapi.x new file mode 100644 index 00000000..d559a130 --- /dev/null +++ b/sys/vops/lz/amapi.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAP -- Vector linear transformation. Map the range of pixel values +# a1,a2 from a into the range b1,b2 in b. It is assumed that a1 < a2 +# and b1 < b2. + +procedure amapi (a, b, npix, a1, a2, b1, b2) + +int a[ARB], b[ARB] +int a1, a2, b1, b2 + +long minout, maxout, aoff, boff, pixval + +real scalar + +int npix, i + +begin + scalar = (real (b2) - real (b1)) / (real (a2) - real (a1)) + + minout = min (b1, b2) + maxout = max (b1, b2) + aoff = a1 + boff = b1 + + do i = 1, npix { + pixval = (a[i] - aoff) * scalar + b[i] = max(minout, min(maxout, pixval + boff)) + } +end diff --git a/sys/vops/lz/amapl.x b/sys/vops/lz/amapl.x new file mode 100644 index 00000000..c9d350bd --- /dev/null +++ b/sys/vops/lz/amapl.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAP -- Vector linear transformation. Map the range of pixel values +# a1,a2 from a into the range b1,b2 in b. It is assumed that a1 < a2 +# and b1 < b2. + +procedure amapl (a, b, npix, a1, a2, b1, b2) + +long a[ARB], b[ARB] +long a1, a2, b1, b2 + +long minout, maxout, aoff, boff, pixval + +double scalar + +int npix, i + +begin + scalar = (double (b2) - double (b1)) / (double (a2) - double (a1)) + + minout = min (b1, b2) + maxout = max (b1, b2) + aoff = a1 + boff = b1 + + do i = 1, npix { + pixval = (a[i] - aoff) * scalar + b[i] = max(minout, min(maxout, pixval + boff)) + } +end diff --git a/sys/vops/lz/amapr.x b/sys/vops/lz/amapr.x new file mode 100644 index 00000000..d23c44b6 --- /dev/null +++ b/sys/vops/lz/amapr.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAP -- Vector linear transformation. Map the range of pixel values +# a1,a2 from a into the range b1,b2 in b. It is assumed that a1 < a2 +# and b1 < b2. + +procedure amapr (a, b, npix, a1, a2, b1, b2) + +real a[ARB], b[ARB] +real a1, a2, b1, b2 + +real minout, maxout, aoff, boff, pixval + +real scalar + +int npix, i + +begin + scalar = (real (b2) - real (b1)) / (real (a2) - real (a1)) + + minout = min (b1, b2) + maxout = max (b1, b2) + aoff = a1 + boff = b1 + + do i = 1, npix { + pixval = (a[i] - aoff) * scalar + b[i] = max(minout, min(maxout, pixval + boff)) + } +end diff --git a/sys/vops/lz/amaps.x b/sys/vops/lz/amaps.x new file mode 100644 index 00000000..fd3b8fe0 --- /dev/null +++ b/sys/vops/lz/amaps.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAP -- Vector linear transformation. Map the range of pixel values +# a1,a2 from a into the range b1,b2 in b. It is assumed that a1 < a2 +# and b1 < b2. + +procedure amaps (a, b, npix, a1, a2, b1, b2) + +short a[ARB], b[ARB] +short a1, a2, b1, b2 + +long minout, maxout, aoff, boff, pixval + +real scalar + +int npix, i + +begin + scalar = (real (b2) - real (b1)) / (real (a2) - real (a1)) + + minout = min (b1, b2) + maxout = max (b1, b2) + aoff = a1 + boff = b1 + + do i = 1, npix { + pixval = (a[i] - aoff) * scalar + b[i] = max(minout, min(maxout, pixval + boff)) + } +end diff --git a/sys/vops/lz/amaxc.x b/sys/vops/lz/amaxc.x new file mode 100644 index 00000000..89c5808b --- /dev/null +++ b/sys/vops/lz/amaxc.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAX -- Compute the maximum of two vectors (generic). + +procedure amaxc (a, b, c, npix) + +char a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = max (a[i], b[i]) +end diff --git a/sys/vops/lz/amaxd.x b/sys/vops/lz/amaxd.x new file mode 100644 index 00000000..0cd8253b --- /dev/null +++ b/sys/vops/lz/amaxd.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAX -- Compute the maximum of two vectors (generic). + +procedure amaxd (a, b, c, npix) + +double a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = max (a[i], b[i]) +end diff --git a/sys/vops/lz/amaxi.x b/sys/vops/lz/amaxi.x new file mode 100644 index 00000000..0b2f4330 --- /dev/null +++ b/sys/vops/lz/amaxi.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAX -- Compute the maximum of two vectors (generic). + +procedure amaxi (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = max (a[i], b[i]) +end diff --git a/sys/vops/lz/amaxkc.x b/sys/vops/lz/amaxkc.x new file mode 100644 index 00000000..1b5d250b --- /dev/null +++ b/sys/vops/lz/amaxkc.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAXK -- Compute the maximum of a constant and a vector (generic). + +procedure amaxkc (a, b, c, npix) + +char a[ARB] +char b +char c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = max (a[i], b) +end diff --git a/sys/vops/lz/amaxkd.x b/sys/vops/lz/amaxkd.x new file mode 100644 index 00000000..afe6e45e --- /dev/null +++ b/sys/vops/lz/amaxkd.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAXK -- Compute the maximum of a constant and a vector (generic). + +procedure amaxkd (a, b, c, npix) + +double a[ARB] +double b +double c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = max (a[i], b) +end diff --git a/sys/vops/lz/amaxki.x b/sys/vops/lz/amaxki.x new file mode 100644 index 00000000..6c74ab6e --- /dev/null +++ b/sys/vops/lz/amaxki.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAXK -- Compute the maximum of a constant and a vector (generic). + +procedure amaxki (a, b, c, npix) + +int a[ARB] +int b +int c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = max (a[i], b) +end diff --git a/sys/vops/lz/amaxkl.x b/sys/vops/lz/amaxkl.x new file mode 100644 index 00000000..bfede4ea --- /dev/null +++ b/sys/vops/lz/amaxkl.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAXK -- Compute the maximum of a constant and a vector (generic). + +procedure amaxkl (a, b, c, npix) + +long a[ARB] +long b +long c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = max (a[i], b) +end diff --git a/sys/vops/lz/amaxkr.x b/sys/vops/lz/amaxkr.x new file mode 100644 index 00000000..766c12e5 --- /dev/null +++ b/sys/vops/lz/amaxkr.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAXK -- Compute the maximum of a constant and a vector (generic). + +procedure amaxkr (a, b, c, npix) + +real a[ARB] +real b +real c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = max (a[i], b) +end diff --git a/sys/vops/lz/amaxks.x b/sys/vops/lz/amaxks.x new file mode 100644 index 00000000..31aeb0b0 --- /dev/null +++ b/sys/vops/lz/amaxks.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAXK -- Compute the maximum of a constant and a vector (generic). + +procedure amaxks (a, b, c, npix) + +short a[ARB] +short b +short c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = max (a[i], b) +end diff --git a/sys/vops/lz/amaxkx.x b/sys/vops/lz/amaxkx.x new file mode 100644 index 00000000..9c3212eb --- /dev/null +++ b/sys/vops/lz/amaxkx.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAXK -- Compute the maximum of a constant and a vector (generic). + +procedure amaxkx (a, b, c, npix) + +complex a[ARB] +complex b +complex c[ARB] +int npix, i +real abs_b + +begin + abs_b = abs (b) + + do i = 1, npix + if (abs(a[i]) >= abs_b) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/amaxl.x b/sys/vops/lz/amaxl.x new file mode 100644 index 00000000..5f12ba92 --- /dev/null +++ b/sys/vops/lz/amaxl.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAX -- Compute the maximum of two vectors (generic). + +procedure amaxl (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = max (a[i], b[i]) +end diff --git a/sys/vops/lz/amaxr.x b/sys/vops/lz/amaxr.x new file mode 100644 index 00000000..c6789d5f --- /dev/null +++ b/sys/vops/lz/amaxr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAX -- Compute the maximum of two vectors (generic). + +procedure amaxr (a, b, c, npix) + +real a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = max (a[i], b[i]) +end diff --git a/sys/vops/lz/amaxs.x b/sys/vops/lz/amaxs.x new file mode 100644 index 00000000..83adb3dc --- /dev/null +++ b/sys/vops/lz/amaxs.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAX -- Compute the maximum of two vectors (generic). + +procedure amaxs (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = max (a[i], b[i]) +end diff --git a/sys/vops/lz/amaxx.x b/sys/vops/lz/amaxx.x new file mode 100644 index 00000000..7f9b58bb --- /dev/null +++ b/sys/vops/lz/amaxx.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMAX -- Compute the maximum of two vectors (generic). + +procedure amaxx (a, b, c, npix) + +complex a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + if (abs(a[i]) >= abs(b[i])) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/amed3c.x b/sys/vops/lz/amed3c.x new file mode 100644 index 00000000..f40f6dc1 --- /dev/null +++ b/sys/vops/lz/amed3c.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED3 -- Median of three vectors. Each output point M[i] is the median value +# of the three input points A[i],B[i],C[i]. + +procedure amed3c (a, b, c, m, npix) + +char a[ARB], b[ARB], c[ARB] # input vectors +char m[ARB] # output vector (median) +int npix +int i + +begin + do i = 1, npix + if (a[i] < b[i]) { + if (b[i] < c[i]) # abc + m[i] = b[i] + else if (a[i] < c[i]) # acb + m[i] = c[i] + else # cab + m[i] = a[i] + } else { + if (b[i] > c[i]) # cba + m[i] = b[i] + else if (a[i] > c[i]) # bca + m[i] = c[i] + else # bac + m[i] = a[i] + } +end diff --git a/sys/vops/lz/amed3d.x b/sys/vops/lz/amed3d.x new file mode 100644 index 00000000..74fba3c4 --- /dev/null +++ b/sys/vops/lz/amed3d.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED3 -- Median of three vectors. Each output point M[i] is the median value +# of the three input points A[i],B[i],C[i]. + +procedure amed3d (a, b, c, m, npix) + +double a[ARB], b[ARB], c[ARB] # input vectors +double m[ARB] # output vector (median) +int npix +int i + +begin + do i = 1, npix + if (a[i] < b[i]) { + if (b[i] < c[i]) # abc + m[i] = b[i] + else if (a[i] < c[i]) # acb + m[i] = c[i] + else # cab + m[i] = a[i] + } else { + if (b[i] > c[i]) # cba + m[i] = b[i] + else if (a[i] > c[i]) # bca + m[i] = c[i] + else # bac + m[i] = a[i] + } +end diff --git a/sys/vops/lz/amed3i.x b/sys/vops/lz/amed3i.x new file mode 100644 index 00000000..2be5fb15 --- /dev/null +++ b/sys/vops/lz/amed3i.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED3 -- Median of three vectors. Each output point M[i] is the median value +# of the three input points A[i],B[i],C[i]. + +procedure amed3i (a, b, c, m, npix) + +int a[ARB], b[ARB], c[ARB] # input vectors +int m[ARB] # output vector (median) +int npix +int i + +begin + do i = 1, npix + if (a[i] < b[i]) { + if (b[i] < c[i]) # abc + m[i] = b[i] + else if (a[i] < c[i]) # acb + m[i] = c[i] + else # cab + m[i] = a[i] + } else { + if (b[i] > c[i]) # cba + m[i] = b[i] + else if (a[i] > c[i]) # bca + m[i] = c[i] + else # bac + m[i] = a[i] + } +end diff --git a/sys/vops/lz/amed3l.x b/sys/vops/lz/amed3l.x new file mode 100644 index 00000000..480d3b05 --- /dev/null +++ b/sys/vops/lz/amed3l.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED3 -- Median of three vectors. Each output point M[i] is the median value +# of the three input points A[i],B[i],C[i]. + +procedure amed3l (a, b, c, m, npix) + +long a[ARB], b[ARB], c[ARB] # input vectors +long m[ARB] # output vector (median) +int npix +int i + +begin + do i = 1, npix + if (a[i] < b[i]) { + if (b[i] < c[i]) # abc + m[i] = b[i] + else if (a[i] < c[i]) # acb + m[i] = c[i] + else # cab + m[i] = a[i] + } else { + if (b[i] > c[i]) # cba + m[i] = b[i] + else if (a[i] > c[i]) # bca + m[i] = c[i] + else # bac + m[i] = a[i] + } +end diff --git a/sys/vops/lz/amed3r.x b/sys/vops/lz/amed3r.x new file mode 100644 index 00000000..276efd03 --- /dev/null +++ b/sys/vops/lz/amed3r.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED3 -- Median of three vectors. Each output point M[i] is the median value +# of the three input points A[i],B[i],C[i]. + +procedure amed3r (a, b, c, m, npix) + +real a[ARB], b[ARB], c[ARB] # input vectors +real m[ARB] # output vector (median) +int npix +int i + +begin + do i = 1, npix + if (a[i] < b[i]) { + if (b[i] < c[i]) # abc + m[i] = b[i] + else if (a[i] < c[i]) # acb + m[i] = c[i] + else # cab + m[i] = a[i] + } else { + if (b[i] > c[i]) # cba + m[i] = b[i] + else if (a[i] > c[i]) # bca + m[i] = c[i] + else # bac + m[i] = a[i] + } +end diff --git a/sys/vops/lz/amed3s.x b/sys/vops/lz/amed3s.x new file mode 100644 index 00000000..8de5ff45 --- /dev/null +++ b/sys/vops/lz/amed3s.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED3 -- Median of three vectors. Each output point M[i] is the median value +# of the three input points A[i],B[i],C[i]. + +procedure amed3s (a, b, c, m, npix) + +short a[ARB], b[ARB], c[ARB] # input vectors +short m[ARB] # output vector (median) +int npix +int i + +begin + do i = 1, npix + if (a[i] < b[i]) { + if (b[i] < c[i]) # abc + m[i] = b[i] + else if (a[i] < c[i]) # acb + m[i] = c[i] + else # cab + m[i] = a[i] + } else { + if (b[i] > c[i]) # cba + m[i] = b[i] + else if (a[i] > c[i]) # bca + m[i] = c[i] + else # bac + m[i] = a[i] + } +end diff --git a/sys/vops/lz/amed4c.x b/sys/vops/lz/amed4c.x new file mode 100644 index 00000000..34228107 --- /dev/null +++ b/sys/vops/lz/amed4c.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED4 -- Median of four vectors. Each output point M[i] is the median of the +# four input points A[i],B[i],C[i],D[i]. The vector min and max are also +# computed and returned in the A and D vectors. The input vectors are modifed +# in place. + +procedure amed4c (a, b, c, d, m, npix) + +char a[ARB], b[ARB] # input vectors +char c[ARB], d[ARB] # input vectors +char m[ARB] # output vector (median) +int npix + +int i +char temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + + # Move the maximum value to D[i]. + if (b[i] > d[i]) + swap (b[i], d[i]) + if (c[i] > d[i]) + swap (c[i], d[i]) + + # Return the median value. + if (b[i] < c[i]) + m[i] = b[i] + else + m[i] = c[i] + } +end diff --git a/sys/vops/lz/amed4d.x b/sys/vops/lz/amed4d.x new file mode 100644 index 00000000..aec95abd --- /dev/null +++ b/sys/vops/lz/amed4d.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED4 -- Median of four vectors. Each output point M[i] is the median of the +# four input points A[i],B[i],C[i],D[i]. The vector min and max are also +# computed and returned in the A and D vectors. The input vectors are modifed +# in place. + +procedure amed4d (a, b, c, d, m, npix) + +double a[ARB], b[ARB] # input vectors +double c[ARB], d[ARB] # input vectors +double m[ARB] # output vector (median) +int npix + +int i +double temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + + # Move the maximum value to D[i]. + if (b[i] > d[i]) + swap (b[i], d[i]) + if (c[i] > d[i]) + swap (c[i], d[i]) + + # Return the median value. + if (b[i] < c[i]) + m[i] = b[i] + else + m[i] = c[i] + } +end diff --git a/sys/vops/lz/amed4i.x b/sys/vops/lz/amed4i.x new file mode 100644 index 00000000..f39d01b6 --- /dev/null +++ b/sys/vops/lz/amed4i.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED4 -- Median of four vectors. Each output point M[i] is the median of the +# four input points A[i],B[i],C[i],D[i]. The vector min and max are also +# computed and returned in the A and D vectors. The input vectors are modifed +# in place. + +procedure amed4i (a, b, c, d, m, npix) + +int a[ARB], b[ARB] # input vectors +int c[ARB], d[ARB] # input vectors +int m[ARB] # output vector (median) +int npix + +int i +int temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + + # Move the maximum value to D[i]. + if (b[i] > d[i]) + swap (b[i], d[i]) + if (c[i] > d[i]) + swap (c[i], d[i]) + + # Return the median value. + if (b[i] < c[i]) + m[i] = b[i] + else + m[i] = c[i] + } +end diff --git a/sys/vops/lz/amed4l.x b/sys/vops/lz/amed4l.x new file mode 100644 index 00000000..367124ef --- /dev/null +++ b/sys/vops/lz/amed4l.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED4 -- Median of four vectors. Each output point M[i] is the median of the +# four input points A[i],B[i],C[i],D[i]. The vector min and max are also +# computed and returned in the A and D vectors. The input vectors are modifed +# in place. + +procedure amed4l (a, b, c, d, m, npix) + +long a[ARB], b[ARB] # input vectors +long c[ARB], d[ARB] # input vectors +long m[ARB] # output vector (median) +int npix + +int i +long temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + + # Move the maximum value to D[i]. + if (b[i] > d[i]) + swap (b[i], d[i]) + if (c[i] > d[i]) + swap (c[i], d[i]) + + # Return the median value. + if (b[i] < c[i]) + m[i] = b[i] + else + m[i] = c[i] + } +end diff --git a/sys/vops/lz/amed4r.x b/sys/vops/lz/amed4r.x new file mode 100644 index 00000000..386ca7a5 --- /dev/null +++ b/sys/vops/lz/amed4r.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED4 -- Median of four vectors. Each output point M[i] is the median of the +# four input points A[i],B[i],C[i],D[i]. The vector min and max are also +# computed and returned in the A and D vectors. The input vectors are modifed +# in place. + +procedure amed4r (a, b, c, d, m, npix) + +real a[ARB], b[ARB] # input vectors +real c[ARB], d[ARB] # input vectors +real m[ARB] # output vector (median) +int npix + +int i +real temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + + # Move the maximum value to D[i]. + if (b[i] > d[i]) + swap (b[i], d[i]) + if (c[i] > d[i]) + swap (c[i], d[i]) + + # Return the median value. + if (b[i] < c[i]) + m[i] = b[i] + else + m[i] = c[i] + } +end diff --git a/sys/vops/lz/amed4s.x b/sys/vops/lz/amed4s.x new file mode 100644 index 00000000..3ed8fe1d --- /dev/null +++ b/sys/vops/lz/amed4s.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED4 -- Median of four vectors. Each output point M[i] is the median of the +# four input points A[i],B[i],C[i],D[i]. The vector min and max are also +# computed and returned in the A and D vectors. The input vectors are modifed +# in place. + +procedure amed4s (a, b, c, d, m, npix) + +short a[ARB], b[ARB] # input vectors +short c[ARB], d[ARB] # input vectors +short m[ARB] # output vector (median) +int npix + +int i +short temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + + # Move the maximum value to D[i]. + if (b[i] > d[i]) + swap (b[i], d[i]) + if (c[i] > d[i]) + swap (c[i], d[i]) + + # Return the median value. + if (b[i] < c[i]) + m[i] = b[i] + else + m[i] = c[i] + } +end diff --git a/sys/vops/lz/amed5c.x b/sys/vops/lz/amed5c.x new file mode 100644 index 00000000..8302e080 --- /dev/null +++ b/sys/vops/lz/amed5c.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED5 -- Median of five vectors. Each output point M[i] is the median of the +# five input points A[i],B[i],C[i],D[i],E[i]. The vector min and max are also +# computed and returned in the A and E vectors. The input vectors are modifed. + +procedure amed5c (a, b, c, d, e, m, npix) + +char a[ARB], b[ARB] # input vectors +char c[ARB], d[ARB], e[ARB] # input vectors +char m[ARB] # output vector (median) +int npix + +int i +char temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + if (e[i] < a[i]) + swap (e[i], a[i]) + + # Move the maximum value to E[i]. + if (b[i] > e[i]) + swap (b[i], e[i]) + if (c[i] > e[i]) + swap (c[i], e[i]) + if (d[i] > e[i]) + swap (d[i], e[i]) + + # Return the median value of the central three points. + if (b[i] < c[i]) { + if (c[i] < d[i]) # bcd + m[i] = c[i] + else if (b[i] < d[i]) # bdc + m[i] = d[i] + else # dbc + m[i] = b[i] + } else { + if (c[i] > d[i]) # dcb + m[i] = c[i] + else if (b[i] > d[i]) # cdb + m[i] = d[i] + else # cbd + m[i] = b[i] + } + } +end diff --git a/sys/vops/lz/amed5d.x b/sys/vops/lz/amed5d.x new file mode 100644 index 00000000..a813f82f --- /dev/null +++ b/sys/vops/lz/amed5d.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED5 -- Median of five vectors. Each output point M[i] is the median of the +# five input points A[i],B[i],C[i],D[i],E[i]. The vector min and max are also +# computed and returned in the A and E vectors. The input vectors are modifed. + +procedure amed5d (a, b, c, d, e, m, npix) + +double a[ARB], b[ARB] # input vectors +double c[ARB], d[ARB], e[ARB] # input vectors +double m[ARB] # output vector (median) +int npix + +int i +double temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + if (e[i] < a[i]) + swap (e[i], a[i]) + + # Move the maximum value to E[i]. + if (b[i] > e[i]) + swap (b[i], e[i]) + if (c[i] > e[i]) + swap (c[i], e[i]) + if (d[i] > e[i]) + swap (d[i], e[i]) + + # Return the median value of the central three points. + if (b[i] < c[i]) { + if (c[i] < d[i]) # bcd + m[i] = c[i] + else if (b[i] < d[i]) # bdc + m[i] = d[i] + else # dbc + m[i] = b[i] + } else { + if (c[i] > d[i]) # dcb + m[i] = c[i] + else if (b[i] > d[i]) # cdb + m[i] = d[i] + else # cbd + m[i] = b[i] + } + } +end diff --git a/sys/vops/lz/amed5i.x b/sys/vops/lz/amed5i.x new file mode 100644 index 00000000..9738be6a --- /dev/null +++ b/sys/vops/lz/amed5i.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED5 -- Median of five vectors. Each output point M[i] is the median of the +# five input points A[i],B[i],C[i],D[i],E[i]. The vector min and max are also +# computed and returned in the A and E vectors. The input vectors are modifed. + +procedure amed5i (a, b, c, d, e, m, npix) + +int a[ARB], b[ARB] # input vectors +int c[ARB], d[ARB], e[ARB] # input vectors +int m[ARB] # output vector (median) +int npix + +int i +int temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + if (e[i] < a[i]) + swap (e[i], a[i]) + + # Move the maximum value to E[i]. + if (b[i] > e[i]) + swap (b[i], e[i]) + if (c[i] > e[i]) + swap (c[i], e[i]) + if (d[i] > e[i]) + swap (d[i], e[i]) + + # Return the median value of the central three points. + if (b[i] < c[i]) { + if (c[i] < d[i]) # bcd + m[i] = c[i] + else if (b[i] < d[i]) # bdc + m[i] = d[i] + else # dbc + m[i] = b[i] + } else { + if (c[i] > d[i]) # dcb + m[i] = c[i] + else if (b[i] > d[i]) # cdb + m[i] = d[i] + else # cbd + m[i] = b[i] + } + } +end diff --git a/sys/vops/lz/amed5l.x b/sys/vops/lz/amed5l.x new file mode 100644 index 00000000..33bd869d --- /dev/null +++ b/sys/vops/lz/amed5l.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED5 -- Median of five vectors. Each output point M[i] is the median of the +# five input points A[i],B[i],C[i],D[i],E[i]. The vector min and max are also +# computed and returned in the A and E vectors. The input vectors are modifed. + +procedure amed5l (a, b, c, d, e, m, npix) + +long a[ARB], b[ARB] # input vectors +long c[ARB], d[ARB], e[ARB] # input vectors +long m[ARB] # output vector (median) +int npix + +int i +long temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + if (e[i] < a[i]) + swap (e[i], a[i]) + + # Move the maximum value to E[i]. + if (b[i] > e[i]) + swap (b[i], e[i]) + if (c[i] > e[i]) + swap (c[i], e[i]) + if (d[i] > e[i]) + swap (d[i], e[i]) + + # Return the median value of the central three points. + if (b[i] < c[i]) { + if (c[i] < d[i]) # bcd + m[i] = c[i] + else if (b[i] < d[i]) # bdc + m[i] = d[i] + else # dbc + m[i] = b[i] + } else { + if (c[i] > d[i]) # dcb + m[i] = c[i] + else if (b[i] > d[i]) # cdb + m[i] = d[i] + else # cbd + m[i] = b[i] + } + } +end diff --git a/sys/vops/lz/amed5r.x b/sys/vops/lz/amed5r.x new file mode 100644 index 00000000..9bce0597 --- /dev/null +++ b/sys/vops/lz/amed5r.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED5 -- Median of five vectors. Each output point M[i] is the median of the +# five input points A[i],B[i],C[i],D[i],E[i]. The vector min and max are also +# computed and returned in the A and E vectors. The input vectors are modifed. + +procedure amed5r (a, b, c, d, e, m, npix) + +real a[ARB], b[ARB] # input vectors +real c[ARB], d[ARB], e[ARB] # input vectors +real m[ARB] # output vector (median) +int npix + +int i +real temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + if (e[i] < a[i]) + swap (e[i], a[i]) + + # Move the maximum value to E[i]. + if (b[i] > e[i]) + swap (b[i], e[i]) + if (c[i] > e[i]) + swap (c[i], e[i]) + if (d[i] > e[i]) + swap (d[i], e[i]) + + # Return the median value of the central three points. + if (b[i] < c[i]) { + if (c[i] < d[i]) # bcd + m[i] = c[i] + else if (b[i] < d[i]) # bdc + m[i] = d[i] + else # dbc + m[i] = b[i] + } else { + if (c[i] > d[i]) # dcb + m[i] = c[i] + else if (b[i] > d[i]) # cdb + m[i] = d[i] + else # cbd + m[i] = b[i] + } + } +end diff --git a/sys/vops/lz/amed5s.x b/sys/vops/lz/amed5s.x new file mode 100644 index 00000000..31f34696 --- /dev/null +++ b/sys/vops/lz/amed5s.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED5 -- Median of five vectors. Each output point M[i] is the median of the +# five input points A[i],B[i],C[i],D[i],E[i]. The vector min and max are also +# computed and returned in the A and E vectors. The input vectors are modifed. + +procedure amed5s (a, b, c, d, e, m, npix) + +short a[ARB], b[ARB] # input vectors +short c[ARB], d[ARB], e[ARB] # input vectors +short m[ARB] # output vector (median) +int npix + +int i +short temp +define swap {temp=$1;$1=$2;$2=temp} + +begin + do i = 1, npix { + # Move the minimum value to A[i]. + if (b[i] < a[i]) + swap (b[i], a[i]) + if (c[i] < a[i]) + swap (c[i], a[i]) + if (d[i] < a[i]) + swap (d[i], a[i]) + if (e[i] < a[i]) + swap (e[i], a[i]) + + # Move the maximum value to E[i]. + if (b[i] > e[i]) + swap (b[i], e[i]) + if (c[i] > e[i]) + swap (c[i], e[i]) + if (d[i] > e[i]) + swap (d[i], e[i]) + + # Return the median value of the central three points. + if (b[i] < c[i]) { + if (c[i] < d[i]) # bcd + m[i] = c[i] + else if (b[i] < d[i]) # bdc + m[i] = d[i] + else # dbc + m[i] = b[i] + } else { + if (c[i] > d[i]) # dcb + m[i] = c[i] + else if (b[i] > d[i]) # cdb + m[i] = d[i] + else # cbd + m[i] = b[i] + } + } +end diff --git a/sys/vops/lz/amedc.x b/sys/vops/lz/amedc.x new file mode 100644 index 00000000..09dcf10c --- /dev/null +++ b/sys/vops/lz/amedc.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED -- Vector median selection. The selection is carried out in a temporary +# array, leaving the input vector unmodified. Especially demanding applications +# may wish to call the asok routine directory to avoid the call to the memory +# allocator. + +char procedure amedc (a, npix) + +char a[ARB] +int npix + +pointer sp, aa +char median +char asokc() # select the Kth smallest element from A + +begin + switch (npix) { + case 1, 2: + return (a[1]) + + case 3: + if (a[1] < a[2]) { + if (a[2] < a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[3]) + else + return (a[1]) + } else { + if (a[2] > a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[1]) + else + return (a[3]) + } + + default: + call smark (sp) + call salloc (aa, npix, TY_CHAR) + call amovc (a, Memc[aa], npix) + median = asokc (Memc[aa], npix, (npix + 1) / 2) + call sfree (sp) + + return (median) + } +end diff --git a/sys/vops/lz/amedd.x b/sys/vops/lz/amedd.x new file mode 100644 index 00000000..c3fbc3aa --- /dev/null +++ b/sys/vops/lz/amedd.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED -- Vector median selection. The selection is carried out in a temporary +# array, leaving the input vector unmodified. Especially demanding applications +# may wish to call the asok routine directory to avoid the call to the memory +# allocator. + +double procedure amedd (a, npix) + +double a[ARB] +int npix + +pointer sp, aa +double median +double asokd() # select the Kth smallest element from A + +begin + switch (npix) { + case 1, 2: + return (a[1]) + + case 3: + if (a[1] < a[2]) { + if (a[2] < a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[3]) + else + return (a[1]) + } else { + if (a[2] > a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[1]) + else + return (a[3]) + } + + default: + call smark (sp) + call salloc (aa, npix, TY_DOUBLE) + call amovd (a, Memd[aa], npix) + median = asokd (Memd[aa], npix, (npix + 1) / 2) + call sfree (sp) + + return (median) + } +end diff --git a/sys/vops/lz/amedi.x b/sys/vops/lz/amedi.x new file mode 100644 index 00000000..69c1ce77 --- /dev/null +++ b/sys/vops/lz/amedi.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED -- Vector median selection. The selection is carried out in a temporary +# array, leaving the input vector unmodified. Especially demanding applications +# may wish to call the asok routine directory to avoid the call to the memory +# allocator. + +int procedure amedi (a, npix) + +int a[ARB] +int npix + +pointer sp, aa +int median +int asoki() # select the Kth smallest element from A + +begin + switch (npix) { + case 1, 2: + return (a[1]) + + case 3: + if (a[1] < a[2]) { + if (a[2] < a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[3]) + else + return (a[1]) + } else { + if (a[2] > a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[1]) + else + return (a[3]) + } + + default: + call smark (sp) + call salloc (aa, npix, TY_INT) + call amovi (a, Memi[aa], npix) + median = asoki (Memi[aa], npix, (npix + 1) / 2) + call sfree (sp) + + return (median) + } +end diff --git a/sys/vops/lz/amedl.x b/sys/vops/lz/amedl.x new file mode 100644 index 00000000..8a993fd2 --- /dev/null +++ b/sys/vops/lz/amedl.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED -- Vector median selection. The selection is carried out in a temporary +# array, leaving the input vector unmodified. Especially demanding applications +# may wish to call the asok routine directory to avoid the call to the memory +# allocator. + +long procedure amedl (a, npix) + +long a[ARB] +int npix + +pointer sp, aa +long median +long asokl() # select the Kth smallest element from A + +begin + switch (npix) { + case 1, 2: + return (a[1]) + + case 3: + if (a[1] < a[2]) { + if (a[2] < a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[3]) + else + return (a[1]) + } else { + if (a[2] > a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[1]) + else + return (a[3]) + } + + default: + call smark (sp) + call salloc (aa, npix, TY_LONG) + call amovl (a, Meml[aa], npix) + median = asokl (Meml[aa], npix, (npix + 1) / 2) + call sfree (sp) + + return (median) + } +end diff --git a/sys/vops/lz/amedr.x b/sys/vops/lz/amedr.x new file mode 100644 index 00000000..e459b22a --- /dev/null +++ b/sys/vops/lz/amedr.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED -- Vector median selection. The selection is carried out in a temporary +# array, leaving the input vector unmodified. Especially demanding applications +# may wish to call the asok routine directory to avoid the call to the memory +# allocator. + +real procedure amedr (a, npix) + +real a[ARB] +int npix + +pointer sp, aa +real median +real asokr() # select the Kth smallest element from A + +begin + switch (npix) { + case 1, 2: + return (a[1]) + + case 3: + if (a[1] < a[2]) { + if (a[2] < a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[3]) + else + return (a[1]) + } else { + if (a[2] > a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[1]) + else + return (a[3]) + } + + default: + call smark (sp) + call salloc (aa, npix, TY_REAL) + call amovr (a, Memr[aa], npix) + median = asokr (Memr[aa], npix, (npix + 1) / 2) + call sfree (sp) + + return (median) + } +end diff --git a/sys/vops/lz/ameds.x b/sys/vops/lz/ameds.x new file mode 100644 index 00000000..5d4d28db --- /dev/null +++ b/sys/vops/lz/ameds.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED -- Vector median selection. The selection is carried out in a temporary +# array, leaving the input vector unmodified. Especially demanding applications +# may wish to call the asok routine directory to avoid the call to the memory +# allocator. + +short procedure ameds (a, npix) + +short a[ARB] +int npix + +pointer sp, aa +short median +short asoks() # select the Kth smallest element from A + +begin + switch (npix) { + case 1, 2: + return (a[1]) + + case 3: + if (a[1] < a[2]) { + if (a[2] < a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[3]) + else + return (a[1]) + } else { + if (a[2] > a[3]) + return (a[2]) + else if (a[1] < a[3]) + return (a[1]) + else + return (a[3]) + } + + default: + call smark (sp) + call salloc (aa, npix, TY_SHORT) + call amovs (a, Mems[aa], npix) + median = asoks (Mems[aa], npix, (npix + 1) / 2) + call sfree (sp) + + return (median) + } +end diff --git a/sys/vops/lz/amedx.x b/sys/vops/lz/amedx.x new file mode 100644 index 00000000..ca2b75dc --- /dev/null +++ b/sys/vops/lz/amedx.x @@ -0,0 +1,52 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMED -- Vector median selection. The selection is carried out in a temporary +# array, leaving the input vector unmodified. Especially demanding applications +# may wish to call the asok routine directory to avoid the call to the memory +# allocator. + +complex procedure amedx (a, npix) + +complex a[ARB] +int npix + +pointer sp, aa +complex median +complex asokx() # select the Kth smallest element from A +real a1, a2, a3 + +begin + switch (npix) { + case 1, 2: + return (a[1]) + + case 3: + a1 = abs (a[1]) + a2 = abs (a[2]) + a3 = abs (a[3]) + if (a1 < a2) { + if (a2 < a3) + return (a[2]) + else if (a1 < a3) + return (a[3]) + else + return (a[1]) + } else { + if (a2 > a3) + return (a[2]) + else if (a1 < a3) + return (a[1]) + else + return (a[3]) + } + + default: + call smark (sp) + call salloc (aa, npix, TY_COMPLEX) + call amovx (a, Memx[aa], npix) + median = asokx (Memx[aa], npix, (npix + 1) / 2) + call sfree (sp) + + return (median) + } +end diff --git a/sys/vops/lz/amgsd.x b/sys/vops/lz/amgsd.x new file mode 100644 index 00000000..36efe58e --- /dev/null +++ b/sys/vops/lz/amgsd.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMGS -- Return the square of the magnitude of two vectors. + +procedure amgsd (a, b, c, npix) + +double a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** 2 + b[i] ** 2 +end diff --git a/sys/vops/lz/amgsi.x b/sys/vops/lz/amgsi.x new file mode 100644 index 00000000..e45a8c70 --- /dev/null +++ b/sys/vops/lz/amgsi.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMGS -- Return the square of the magnitude of two vectors. + +procedure amgsi (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** 2 + b[i] ** 2 +end diff --git a/sys/vops/lz/amgsl.x b/sys/vops/lz/amgsl.x new file mode 100644 index 00000000..6ae850e9 --- /dev/null +++ b/sys/vops/lz/amgsl.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMGS -- Return the square of the magnitude of two vectors. + +procedure amgsl (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** 2 + b[i] ** 2 +end diff --git a/sys/vops/lz/amgsr.x b/sys/vops/lz/amgsr.x new file mode 100644 index 00000000..fbfbb880 --- /dev/null +++ b/sys/vops/lz/amgsr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMGS -- Return the square of the magnitude of two vectors. + +procedure amgsr (a, b, c, npix) + +real a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** 2 + b[i] ** 2 +end diff --git a/sys/vops/lz/amgss.x b/sys/vops/lz/amgss.x new file mode 100644 index 00000000..592d520c --- /dev/null +++ b/sys/vops/lz/amgss.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMGS -- Return the square of the magnitude of two vectors. + +procedure amgss (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** 2 + b[i] ** 2 +end diff --git a/sys/vops/lz/amgsx.x b/sys/vops/lz/amgsx.x new file mode 100644 index 00000000..c40834f4 --- /dev/null +++ b/sys/vops/lz/amgsx.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMGS -- Return the square of the magnitude of two vectors. + +procedure amgsx (a, b, c, npix) + +complex a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** 2 + b[i] ** 2 +end diff --git a/sys/vops/lz/aminc.x b/sys/vops/lz/aminc.x new file mode 100644 index 00000000..a319819e --- /dev/null +++ b/sys/vops/lz/aminc.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMIN -- Compute the minimum of two vectors (generic). + +procedure aminc (a, b, c, npix) + +char a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = min (a[i], b[i]) +end diff --git a/sys/vops/lz/amind.x b/sys/vops/lz/amind.x new file mode 100644 index 00000000..e1574051 --- /dev/null +++ b/sys/vops/lz/amind.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMIN -- Compute the minimum of two vectors (generic). + +procedure amind (a, b, c, npix) + +double a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = min (a[i], b[i]) +end diff --git a/sys/vops/lz/amini.x b/sys/vops/lz/amini.x new file mode 100644 index 00000000..c7a76820 --- /dev/null +++ b/sys/vops/lz/amini.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMIN -- Compute the minimum of two vectors (generic). + +procedure amini (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = min (a[i], b[i]) +end diff --git a/sys/vops/lz/aminkc.x b/sys/vops/lz/aminkc.x new file mode 100644 index 00000000..a9b91e0e --- /dev/null +++ b/sys/vops/lz/aminkc.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMINK -- Compute the minimum of a constant and a vector (generic). + +procedure aminkc (a, b, c, npix) + +char a[ARB] +char b +char c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = min (a[i], b) +end diff --git a/sys/vops/lz/aminkd.x b/sys/vops/lz/aminkd.x new file mode 100644 index 00000000..6b8a0506 --- /dev/null +++ b/sys/vops/lz/aminkd.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMINK -- Compute the minimum of a constant and a vector (generic). + +procedure aminkd (a, b, c, npix) + +double a[ARB] +double b +double c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = min (a[i], b) +end diff --git a/sys/vops/lz/aminki.x b/sys/vops/lz/aminki.x new file mode 100644 index 00000000..b2793c71 --- /dev/null +++ b/sys/vops/lz/aminki.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMINK -- Compute the minimum of a constant and a vector (generic). + +procedure aminki (a, b, c, npix) + +int a[ARB] +int b +int c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = min (a[i], b) +end diff --git a/sys/vops/lz/aminkl.x b/sys/vops/lz/aminkl.x new file mode 100644 index 00000000..530b326f --- /dev/null +++ b/sys/vops/lz/aminkl.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMINK -- Compute the minimum of a constant and a vector (generic). + +procedure aminkl (a, b, c, npix) + +long a[ARB] +long b +long c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = min (a[i], b) +end diff --git a/sys/vops/lz/aminkr.x b/sys/vops/lz/aminkr.x new file mode 100644 index 00000000..76000fb7 --- /dev/null +++ b/sys/vops/lz/aminkr.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMINK -- Compute the minimum of a constant and a vector (generic). + +procedure aminkr (a, b, c, npix) + +real a[ARB] +real b +real c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = min (a[i], b) +end diff --git a/sys/vops/lz/aminks.x b/sys/vops/lz/aminks.x new file mode 100644 index 00000000..28d1b358 --- /dev/null +++ b/sys/vops/lz/aminks.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMINK -- Compute the minimum of a constant and a vector (generic). + +procedure aminks (a, b, c, npix) + +short a[ARB] +short b +short c[ARB] +int npix, i + +begin + + do i = 1, npix + c[i] = min (a[i], b) +end diff --git a/sys/vops/lz/aminkx.x b/sys/vops/lz/aminkx.x new file mode 100644 index 00000000..5f0f852d --- /dev/null +++ b/sys/vops/lz/aminkx.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMINK -- Compute the minimum of a constant and a vector (generic). + +procedure aminkx (a, b, c, npix) + +complex a[ARB] +complex b +complex c[ARB] +int npix, i +real abs_b + +begin + abs_b = abs (b) + + do i = 1, npix + if (abs(a[i]) <= abs_b) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/aminl.x b/sys/vops/lz/aminl.x new file mode 100644 index 00000000..d4ae3c7e --- /dev/null +++ b/sys/vops/lz/aminl.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMIN -- Compute the minimum of two vectors (generic). + +procedure aminl (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = min (a[i], b[i]) +end diff --git a/sys/vops/lz/aminr.x b/sys/vops/lz/aminr.x new file mode 100644 index 00000000..1fafcb35 --- /dev/null +++ b/sys/vops/lz/aminr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMIN -- Compute the minimum of two vectors (generic). + +procedure aminr (a, b, c, npix) + +real a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = min (a[i], b[i]) +end diff --git a/sys/vops/lz/amins.x b/sys/vops/lz/amins.x new file mode 100644 index 00000000..5d89f139 --- /dev/null +++ b/sys/vops/lz/amins.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMIN -- Compute the minimum of two vectors (generic). + +procedure amins (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = min (a[i], b[i]) +end diff --git a/sys/vops/lz/aminx.x b/sys/vops/lz/aminx.x new file mode 100644 index 00000000..591b23e4 --- /dev/null +++ b/sys/vops/lz/aminx.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMIN -- Compute the minimum of two vectors (generic). + +procedure aminx (a, b, c, npix) + +complex a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + if (abs(a[i]) <= abs(b[i])) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/amodd.x b/sys/vops/lz/amodd.x new file mode 100644 index 00000000..fce124b6 --- /dev/null +++ b/sys/vops/lz/amodd.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOD -- Compute the modulus of two vectors (generic). + +procedure amodd (a, b, c, npix) + +double a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b[i]) +end diff --git a/sys/vops/lz/amodi.x b/sys/vops/lz/amodi.x new file mode 100644 index 00000000..f1f5a584 --- /dev/null +++ b/sys/vops/lz/amodi.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOD -- Compute the modulus of two vectors (generic). + +procedure amodi (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b[i]) +end diff --git a/sys/vops/lz/amodkd.x b/sys/vops/lz/amodkd.x new file mode 100644 index 00000000..24db964d --- /dev/null +++ b/sys/vops/lz/amodkd.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMODK -- Compute the modulus of a vector by a constant (generic). + +procedure amodkd (a, b, c, npix) + +double a[ARB] +double b +double c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b) +end diff --git a/sys/vops/lz/amodki.x b/sys/vops/lz/amodki.x new file mode 100644 index 00000000..d2b71438 --- /dev/null +++ b/sys/vops/lz/amodki.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMODK -- Compute the modulus of a vector by a constant (generic). + +procedure amodki (a, b, c, npix) + +int a[ARB] +int b +int c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b) +end diff --git a/sys/vops/lz/amodkl.x b/sys/vops/lz/amodkl.x new file mode 100644 index 00000000..ef9ec8b3 --- /dev/null +++ b/sys/vops/lz/amodkl.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMODK -- Compute the modulus of a vector by a constant (generic). + +procedure amodkl (a, b, c, npix) + +long a[ARB] +long b +long c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b) +end diff --git a/sys/vops/lz/amodkr.x b/sys/vops/lz/amodkr.x new file mode 100644 index 00000000..9aa1bd49 --- /dev/null +++ b/sys/vops/lz/amodkr.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMODK -- Compute the modulus of a vector by a constant (generic). + +procedure amodkr (a, b, c, npix) + +real a[ARB] +real b +real c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b) +end diff --git a/sys/vops/lz/amodks.x b/sys/vops/lz/amodks.x new file mode 100644 index 00000000..be5b719c --- /dev/null +++ b/sys/vops/lz/amodks.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMODK -- Compute the modulus of a vector by a constant (generic). + +procedure amodks (a, b, c, npix) + +short a[ARB] +short b +short c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b) +end diff --git a/sys/vops/lz/amodl.x b/sys/vops/lz/amodl.x new file mode 100644 index 00000000..5dd47d53 --- /dev/null +++ b/sys/vops/lz/amodl.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOD -- Compute the modulus of two vectors (generic). + +procedure amodl (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b[i]) +end diff --git a/sys/vops/lz/amodr.x b/sys/vops/lz/amodr.x new file mode 100644 index 00000000..772a1e9c --- /dev/null +++ b/sys/vops/lz/amodr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOD -- Compute the modulus of two vectors (generic). + +procedure amodr (a, b, c, npix) + +real a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b[i]) +end diff --git a/sys/vops/lz/amods.x b/sys/vops/lz/amods.x new file mode 100644 index 00000000..490d8ec5 --- /dev/null +++ b/sys/vops/lz/amods.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOD -- Compute the modulus of two vectors (generic). + +procedure amods (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = mod (a[i], b[i]) +end diff --git a/sys/vops/lz/amovc.x b/sys/vops/lz/amovc.x new file mode 100644 index 00000000..096d1444 --- /dev/null +++ b/sys/vops/lz/amovc.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOV -- Copy a vector (generic). The operation is carried out in such +# a way that the result is the same whether or not the output vector +# overlaps the input vector. + +procedure amovc (a, b, npix) + +char a[ARB], b[ARB] +int npix, i, a_first, b_first + +begin + call zlocva (a, a_first) + call zlocva (b, b_first) + + if (a_first == b_first) + return + + if (a_first < b_first) { + do i = npix, 1, -1 + b[i] = a[i] + } else { + do i = 1, npix + b[i] = a[i] + } +end diff --git a/sys/vops/lz/amovd.x b/sys/vops/lz/amovd.x new file mode 100644 index 00000000..3924f141 --- /dev/null +++ b/sys/vops/lz/amovd.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOV -- Copy a vector (generic). The operation is carried out in such +# a way that the result is the same whether or not the output vector +# overlaps the input vector. + +procedure amovd (a, b, npix) + +double a[ARB], b[ARB] +int npix, i, a_first, b_first + +begin + call zlocva (a, a_first) + call zlocva (b, b_first) + + if (a_first == b_first) + return + + if (a_first < b_first) { + do i = npix, 1, -1 + b[i] = a[i] + } else { + do i = 1, npix + b[i] = a[i] + } +end diff --git a/sys/vops/lz/amovi.x b/sys/vops/lz/amovi.x new file mode 100644 index 00000000..e97794c7 --- /dev/null +++ b/sys/vops/lz/amovi.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOV -- Copy a vector (generic). The operation is carried out in such +# a way that the result is the same whether or not the output vector +# overlaps the input vector. + +procedure amovi (a, b, npix) + +int a[ARB], b[ARB] +int npix, i, a_first, b_first + +begin + call zlocva (a, a_first) + call zlocva (b, b_first) + + if (a_first == b_first) + return + + if (a_first < b_first) { + do i = npix, 1, -1 + b[i] = a[i] + } else { + do i = 1, npix + b[i] = a[i] + } +end diff --git a/sys/vops/lz/amovkc.x b/sys/vops/lz/amovkc.x new file mode 100644 index 00000000..9be3a496 --- /dev/null +++ b/sys/vops/lz/amovkc.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOVK -- Copy a constant into a vector (generic). + +procedure amovkc (a, b, npix) + +char a +char b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = a +end diff --git a/sys/vops/lz/amovkd.x b/sys/vops/lz/amovkd.x new file mode 100644 index 00000000..4d8eaecd --- /dev/null +++ b/sys/vops/lz/amovkd.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOVK -- Copy a constant into a vector (generic). + +procedure amovkd (a, b, npix) + +double a +double b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = a +end diff --git a/sys/vops/lz/amovki.x b/sys/vops/lz/amovki.x new file mode 100644 index 00000000..67556a23 --- /dev/null +++ b/sys/vops/lz/amovki.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOVK -- Copy a constant into a vector (generic). + +procedure amovki (a, b, npix) + +int a +int b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = a +end diff --git a/sys/vops/lz/amovkl.x b/sys/vops/lz/amovkl.x new file mode 100644 index 00000000..62c96668 --- /dev/null +++ b/sys/vops/lz/amovkl.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOVK -- Copy a constant into a vector (generic). + +procedure amovkl (a, b, npix) + +long a +long b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = a +end diff --git a/sys/vops/lz/amovkr.x b/sys/vops/lz/amovkr.x new file mode 100644 index 00000000..feb34a5c --- /dev/null +++ b/sys/vops/lz/amovkr.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOVK -- Copy a constant into a vector (generic). + +procedure amovkr (a, b, npix) + +real a +real b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = a +end diff --git a/sys/vops/lz/amovks.x b/sys/vops/lz/amovks.x new file mode 100644 index 00000000..3beff9af --- /dev/null +++ b/sys/vops/lz/amovks.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOVK -- Copy a constant into a vector (generic). + +procedure amovks (a, b, npix) + +short a +short b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = a +end diff --git a/sys/vops/lz/amovkx.x b/sys/vops/lz/amovkx.x new file mode 100644 index 00000000..acf90c91 --- /dev/null +++ b/sys/vops/lz/amovkx.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOVK -- Copy a constant into a vector (generic). + +procedure amovkx (a, b, npix) + +complex a +complex b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = a +end diff --git a/sys/vops/lz/amovl.x b/sys/vops/lz/amovl.x new file mode 100644 index 00000000..4cec6bbd --- /dev/null +++ b/sys/vops/lz/amovl.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOV -- Copy a vector (generic). The operation is carried out in such +# a way that the result is the same whether or not the output vector +# overlaps the input vector. + +procedure amovl (a, b, npix) + +long a[ARB], b[ARB] +int npix, i, a_first, b_first + +begin + call zlocva (a, a_first) + call zlocva (b, b_first) + + if (a_first == b_first) + return + + if (a_first < b_first) { + do i = npix, 1, -1 + b[i] = a[i] + } else { + do i = 1, npix + b[i] = a[i] + } +end diff --git a/sys/vops/lz/amovr.x b/sys/vops/lz/amovr.x new file mode 100644 index 00000000..9d6aa8cb --- /dev/null +++ b/sys/vops/lz/amovr.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOV -- Copy a vector (generic). The operation is carried out in such +# a way that the result is the same whether or not the output vector +# overlaps the input vector. + +procedure amovr (a, b, npix) + +real a[ARB], b[ARB] +int npix, i, a_first, b_first + +begin + call zlocva (a, a_first) + call zlocva (b, b_first) + + if (a_first == b_first) + return + + if (a_first < b_first) { + do i = npix, 1, -1 + b[i] = a[i] + } else { + do i = 1, npix + b[i] = a[i] + } +end diff --git a/sys/vops/lz/amovs.x b/sys/vops/lz/amovs.x new file mode 100644 index 00000000..9feaf94a --- /dev/null +++ b/sys/vops/lz/amovs.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOV -- Copy a vector (generic). The operation is carried out in such +# a way that the result is the same whether or not the output vector +# overlaps the input vector. + +procedure amovs (a, b, npix) + +short a[ARB], b[ARB] +int npix, i, a_first, b_first + +begin + call zlocva (a, a_first) + call zlocva (b, b_first) + + if (a_first == b_first) + return + + if (a_first < b_first) { + do i = npix, 1, -1 + b[i] = a[i] + } else { + do i = 1, npix + b[i] = a[i] + } +end diff --git a/sys/vops/lz/amovx.x b/sys/vops/lz/amovx.x new file mode 100644 index 00000000..04d4fdf2 --- /dev/null +++ b/sys/vops/lz/amovx.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMOV -- Copy a vector (generic). The operation is carried out in such +# a way that the result is the same whether or not the output vector +# overlaps the input vector. + +procedure amovx (a, b, npix) + +complex a[ARB], b[ARB] +int npix, i, a_first, b_first + +begin + call zlocva (a, a_first) + call zlocva (b, b_first) + + if (a_first == b_first) + return + + if (a_first < b_first) { + do i = npix, 1, -1 + b[i] = a[i] + } else { + do i = 1, npix + b[i] = a[i] + } +end diff --git a/sys/vops/lz/amuld.x b/sys/vops/lz/amuld.x new file mode 100644 index 00000000..b9a5c13b --- /dev/null +++ b/sys/vops/lz/amuld.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMUL -- Multiply two vectors (generic). + +procedure amuld (a, b, c, npix) + +double a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b[i] +end diff --git a/sys/vops/lz/amuli.x b/sys/vops/lz/amuli.x new file mode 100644 index 00000000..bf2ff538 --- /dev/null +++ b/sys/vops/lz/amuli.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMUL -- Multiply two vectors (generic). + +procedure amuli (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b[i] +end diff --git a/sys/vops/lz/amulkd.x b/sys/vops/lz/amulkd.x new file mode 100644 index 00000000..69f28a9a --- /dev/null +++ b/sys/vops/lz/amulkd.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMULK -- Multiply a constant times a vector (generic). + +procedure amulkd (a, b, c, npix) + +double a[ARB] +double b +double c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b +end diff --git a/sys/vops/lz/amulki.x b/sys/vops/lz/amulki.x new file mode 100644 index 00000000..773a9a12 --- /dev/null +++ b/sys/vops/lz/amulki.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMULK -- Multiply a constant times a vector (generic). + +procedure amulki (a, b, c, npix) + +int a[ARB] +int b +int c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b +end diff --git a/sys/vops/lz/amulkl.x b/sys/vops/lz/amulkl.x new file mode 100644 index 00000000..69cef4c0 --- /dev/null +++ b/sys/vops/lz/amulkl.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMULK -- Multiply a constant times a vector (generic). + +procedure amulkl (a, b, c, npix) + +long a[ARB] +long b +long c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b +end diff --git a/sys/vops/lz/amulkr.x b/sys/vops/lz/amulkr.x new file mode 100644 index 00000000..71cac10c --- /dev/null +++ b/sys/vops/lz/amulkr.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMULK -- Multiply a constant times a vector (generic). + +procedure amulkr (a, b, c, npix) + +real a[ARB] +real b +real c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b +end diff --git a/sys/vops/lz/amulks.x b/sys/vops/lz/amulks.x new file mode 100644 index 00000000..28f6d4ec --- /dev/null +++ b/sys/vops/lz/amulks.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMULK -- Multiply a constant times a vector (generic). + +procedure amulks (a, b, c, npix) + +short a[ARB] +short b +short c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b +end diff --git a/sys/vops/lz/amulkx.x b/sys/vops/lz/amulkx.x new file mode 100644 index 00000000..c3fe3a36 --- /dev/null +++ b/sys/vops/lz/amulkx.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMULK -- Multiply a constant times a vector (generic). + +procedure amulkx (a, b, c, npix) + +complex a[ARB] +complex b +complex c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b +end diff --git a/sys/vops/lz/amull.x b/sys/vops/lz/amull.x new file mode 100644 index 00000000..bb913fe2 --- /dev/null +++ b/sys/vops/lz/amull.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMUL -- Multiply two vectors (generic). + +procedure amull (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b[i] +end diff --git a/sys/vops/lz/amulr.x b/sys/vops/lz/amulr.x new file mode 100644 index 00000000..fe7b204b --- /dev/null +++ b/sys/vops/lz/amulr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMUL -- Multiply two vectors (generic). + +procedure amulr (a, b, c, npix) + +real a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b[i] +end diff --git a/sys/vops/lz/amuls.x b/sys/vops/lz/amuls.x new file mode 100644 index 00000000..ceb5854e --- /dev/null +++ b/sys/vops/lz/amuls.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMUL -- Multiply two vectors (generic). + +procedure amuls (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b[i] +end diff --git a/sys/vops/lz/amulx.x b/sys/vops/lz/amulx.x new file mode 100644 index 00000000..1b9aa3dc --- /dev/null +++ b/sys/vops/lz/amulx.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AMUL -- Multiply two vectors (generic). + +procedure amulx (a, b, c, npix) + +complex a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * b[i] +end diff --git a/sys/vops/lz/anegd.x b/sys/vops/lz/anegd.x new file mode 100644 index 00000000..d681464e --- /dev/null +++ b/sys/vops/lz/anegd.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANEG -- Compute the arithmetic negation of a vector (generic). + +procedure anegd (a, b, npix) + +double a[ARB], b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = -a[i] +end diff --git a/sys/vops/lz/anegi.x b/sys/vops/lz/anegi.x new file mode 100644 index 00000000..d1221376 --- /dev/null +++ b/sys/vops/lz/anegi.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANEG -- Compute the arithmetic negation of a vector (generic). + +procedure anegi (a, b, npix) + +int a[ARB], b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = -a[i] +end diff --git a/sys/vops/lz/anegl.x b/sys/vops/lz/anegl.x new file mode 100644 index 00000000..e3ab64f4 --- /dev/null +++ b/sys/vops/lz/anegl.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANEG -- Compute the arithmetic negation of a vector (generic). + +procedure anegl (a, b, npix) + +long a[ARB], b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = -a[i] +end diff --git a/sys/vops/lz/anegr.x b/sys/vops/lz/anegr.x new file mode 100644 index 00000000..449da1b0 --- /dev/null +++ b/sys/vops/lz/anegr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANEG -- Compute the arithmetic negation of a vector (generic). + +procedure anegr (a, b, npix) + +real a[ARB], b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = -a[i] +end diff --git a/sys/vops/lz/anegs.x b/sys/vops/lz/anegs.x new file mode 100644 index 00000000..7b8f320e --- /dev/null +++ b/sys/vops/lz/anegs.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANEG -- Compute the arithmetic negation of a vector (generic). + +procedure anegs (a, b, npix) + +short a[ARB], b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = -a[i] +end diff --git a/sys/vops/lz/anegx.x b/sys/vops/lz/anegx.x new file mode 100644 index 00000000..8f958084 --- /dev/null +++ b/sys/vops/lz/anegx.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANEG -- Compute the arithmetic negation of a vector (generic). + +procedure anegx (a, b, npix) + +complex a[ARB], b[ARB] +int npix, i + +begin + do i = 1, npix + b[i] = -a[i] +end diff --git a/sys/vops/lz/anoti.x b/sys/vops/lz/anoti.x new file mode 100644 index 00000000..867a8c92 --- /dev/null +++ b/sys/vops/lz/anoti.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANOT -- Compute the bitwise boolean complement of a vector (generic). + +procedure anoti (a, b, npix) + +int a[ARB], b[ARB] +int npix, i +int not() + +begin + do i = 1, npix { + b[i] = not (a[i]) + } +end diff --git a/sys/vops/lz/anotl.x b/sys/vops/lz/anotl.x new file mode 100644 index 00000000..3ecb0fce --- /dev/null +++ b/sys/vops/lz/anotl.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANOT -- Compute the bitwise boolean complement of a vector (generic). + +procedure anotl (a, b, npix) + +long a[ARB], b[ARB] +int npix, i +long notl() + +begin + do i = 1, npix { + b[i] = notl (a[i]) + } +end diff --git a/sys/vops/lz/anots.x b/sys/vops/lz/anots.x new file mode 100644 index 00000000..4c952636 --- /dev/null +++ b/sys/vops/lz/anots.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ANOT -- Compute the bitwise boolean complement of a vector (generic). + +procedure anots (a, b, npix) + +short a[ARB], b[ARB] +int npix, i +short nots() + +begin + do i = 1, npix { + b[i] = nots (a[i]) + } +end diff --git a/sys/vops/lz/apkxd.x b/sys/vops/lz/apkxd.x new file mode 100644 index 00000000..7c489491 --- /dev/null +++ b/sys/vops/lz/apkxd.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APKX -- Generate a type COMPLEX output vector given the real and imaginary +# components as input vectors. + +procedure apkxd (a, b, c, npix) + +double a[ARB] # real component +double b[ARB] # imaginary component +complex c[ARB] # output vector +int npix, i + +begin + do i = 1, npix + c[i] = complex (real(a[i]), real(b[i])) +end diff --git a/sys/vops/lz/apkxi.x b/sys/vops/lz/apkxi.x new file mode 100644 index 00000000..c03a0883 --- /dev/null +++ b/sys/vops/lz/apkxi.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APKX -- Generate a type COMPLEX output vector given the real and imaginary +# components as input vectors. + +procedure apkxi (a, b, c, npix) + +int a[ARB] # real component +int b[ARB] # imaginary component +complex c[ARB] # output vector +int npix, i + +begin + do i = 1, npix + c[i] = complex (real(a[i]), real(b[i])) +end diff --git a/sys/vops/lz/apkxl.x b/sys/vops/lz/apkxl.x new file mode 100644 index 00000000..5af1f9e0 --- /dev/null +++ b/sys/vops/lz/apkxl.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APKX -- Generate a type COMPLEX output vector given the real and imaginary +# components as input vectors. + +procedure apkxl (a, b, c, npix) + +long a[ARB] # real component +long b[ARB] # imaginary component +complex c[ARB] # output vector +int npix, i + +begin + do i = 1, npix + c[i] = complex (real(a[i]), real(b[i])) +end diff --git a/sys/vops/lz/apkxr.x b/sys/vops/lz/apkxr.x new file mode 100644 index 00000000..aba0261a --- /dev/null +++ b/sys/vops/lz/apkxr.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APKX -- Generate a type COMPLEX output vector given the real and imaginary +# components as input vectors. + +procedure apkxr (a, b, c, npix) + +real a[ARB] # real component +real b[ARB] # imaginary component +complex c[ARB] # output vector +int npix, i + +begin + do i = 1, npix + c[i] = complex (real(a[i]), real(b[i])) +end diff --git a/sys/vops/lz/apkxs.x b/sys/vops/lz/apkxs.x new file mode 100644 index 00000000..178683a9 --- /dev/null +++ b/sys/vops/lz/apkxs.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APKX -- Generate a type COMPLEX output vector given the real and imaginary +# components as input vectors. + +procedure apkxs (a, b, c, npix) + +short a[ARB] # real component +short b[ARB] # imaginary component +complex c[ARB] # output vector +int npix, i + +begin + do i = 1, npix + c[i] = complex (real(a[i]), real(b[i])) +end diff --git a/sys/vops/lz/apkxx.x b/sys/vops/lz/apkxx.x new file mode 100644 index 00000000..9baef047 --- /dev/null +++ b/sys/vops/lz/apkxx.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APKX -- Generate a type COMPLEX output vector given the real and imaginary +# components as input vectors. + +procedure apkxx (a, b, c, npix) + +complex a[ARB] # real component +complex b[ARB] # imaginary component +complex c[ARB] # output vector +int npix, i + +begin + do i = 1, npix + c[i] = complex (real(a[i]), aimag(b[i])) +end diff --git a/sys/vops/lz/apold.x b/sys/vops/lz/apold.x new file mode 100644 index 00000000..885ed4fe --- /dev/null +++ b/sys/vops/lz/apold.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOL -- Evaluate a polynomial at X, given the coefficients of the polynomial +# in COEFF and returning the computed value as the function value. + +double procedure apold (x, coeff, ncoeff) + +double x # point at which the polynomial is to be evaluated +double coeff[ncoeff] # coefficients of the polynomial, lower orders first +int ncoeff + +int i +double pow, sum + +begin + sum = coeff[1] + pow = x + + do i = 2, ncoeff { + sum = sum + pow * coeff[i] + pow = pow * x + } + + return (sum) +end diff --git a/sys/vops/lz/apolr.x b/sys/vops/lz/apolr.x new file mode 100644 index 00000000..22912021 --- /dev/null +++ b/sys/vops/lz/apolr.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOL -- Evaluate a polynomial at X, given the coefficients of the polynomial +# in COEFF and returning the computed value as the function value. + +real procedure apolr (x, coeff, ncoeff) + +real x # point at which the polynomial is to be evaluated +real coeff[ncoeff] # coefficients of the polynomial, lower orders first +int ncoeff + +int i +real pow, sum + +begin + sum = coeff[1] + pow = x + + do i = 2, ncoeff { + sum = sum + pow * coeff[i] + pow = pow * x + } + + return (sum) +end diff --git a/sys/vops/lz/apowd.x b/sys/vops/lz/apowd.x new file mode 100644 index 00000000..2f277935 --- /dev/null +++ b/sys/vops/lz/apowd.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOW -- Compute a ** b, where b is of type INT (generic). + +procedure apowd (a, b, c, npix) + +double a[ARB], c[ARB] +int b[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** b[i] +end diff --git a/sys/vops/lz/apowi.x b/sys/vops/lz/apowi.x new file mode 100644 index 00000000..27d587f9 --- /dev/null +++ b/sys/vops/lz/apowi.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOW -- Compute a ** b, where b is of type INT (generic). + +procedure apowi (a, b, c, npix) + +int a[ARB], c[ARB] +int b[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** b[i] +end diff --git a/sys/vops/lz/apowkd.x b/sys/vops/lz/apowkd.x new file mode 100644 index 00000000..8aee1a87 --- /dev/null +++ b/sys/vops/lz/apowkd.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOWK -- Compute a ** b, where b is a constant of type INT (generic). + +procedure apowkd (a, b, c, npix) + +double a[ARB], c[ARB] +int b +int npix, i + +begin + # Optimize the code for the various special cases. We assume that the + # compiler is intelligent enough to recognize the special cases if the + # power is expressed as an integer constant. + + switch (b) { + case 0: + call amovkd (1.0D0, c, npix) + case 1: + call amovd (a, c, npix) + case 2: + do i = 1, npix + c[i] = a[i] ** 2 + case 3: + do i = 1, npix + c[i] = a[i] ** 3 + case 4: + do i = 1, npix + c[i] = a[i] ** 4 + default: + do i = 1, npix + c[i] = a[i] ** b + } +end diff --git a/sys/vops/lz/apowki.x b/sys/vops/lz/apowki.x new file mode 100644 index 00000000..1b756bca --- /dev/null +++ b/sys/vops/lz/apowki.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOWK -- Compute a ** b, where b is a constant of type INT (generic). + +procedure apowki (a, b, c, npix) + +int a[ARB], c[ARB] +int b +int npix, i + +begin + # Optimize the code for the various special cases. We assume that the + # compiler is intelligent enough to recognize the special cases if the + # power is expressed as an integer constant. + + switch (b) { + case 0: + call amovki (1, c, npix) + case 1: + call amovi (a, c, npix) + case 2: + do i = 1, npix + c[i] = a[i] ** 2 + case 3: + do i = 1, npix + c[i] = a[i] ** 3 + case 4: + do i = 1, npix + c[i] = a[i] ** 4 + default: + do i = 1, npix + c[i] = a[i] ** b + } +end diff --git a/sys/vops/lz/apowkl.x b/sys/vops/lz/apowkl.x new file mode 100644 index 00000000..c7247f3e --- /dev/null +++ b/sys/vops/lz/apowkl.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOWK -- Compute a ** b, where b is a constant of type INT (generic). + +procedure apowkl (a, b, c, npix) + +long a[ARB], c[ARB] +int b +int npix, i + +begin + # Optimize the code for the various special cases. We assume that the + # compiler is intelligent enough to recognize the special cases if the + # power is expressed as an integer constant. + + switch (b) { + case 0: + call amovkl (1, c, npix) + case 1: + call amovl (a, c, npix) + case 2: + do i = 1, npix + c[i] = a[i] ** 2 + case 3: + do i = 1, npix + c[i] = a[i] ** 3 + case 4: + do i = 1, npix + c[i] = a[i] ** 4 + default: + do i = 1, npix + c[i] = a[i] ** b + } +end diff --git a/sys/vops/lz/apowkr.x b/sys/vops/lz/apowkr.x new file mode 100644 index 00000000..b22be6b7 --- /dev/null +++ b/sys/vops/lz/apowkr.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOWK -- Compute a ** b, where b is a constant of type INT (generic). + +procedure apowkr (a, b, c, npix) + +real a[ARB], c[ARB] +int b +int npix, i + +begin + # Optimize the code for the various special cases. We assume that the + # compiler is intelligent enough to recognize the special cases if the + # power is expressed as an integer constant. + + switch (b) { + case 0: + call amovkr (1.0, c, npix) + case 1: + call amovr (a, c, npix) + case 2: + do i = 1, npix + c[i] = a[i] ** 2 + case 3: + do i = 1, npix + c[i] = a[i] ** 3 + case 4: + do i = 1, npix + c[i] = a[i] ** 4 + default: + do i = 1, npix + c[i] = a[i] ** b + } +end diff --git a/sys/vops/lz/apowks.x b/sys/vops/lz/apowks.x new file mode 100644 index 00000000..f656115a --- /dev/null +++ b/sys/vops/lz/apowks.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOWK -- Compute a ** b, where b is a constant of type INT (generic). + +procedure apowks (a, b, c, npix) + +short a[ARB], c[ARB] +int b +int npix, i + +begin + # Optimize the code for the various special cases. We assume that the + # compiler is intelligent enough to recognize the special cases if the + # power is expressed as an integer constant. + + switch (b) { + case 0: + call amovks (1, c, npix) + case 1: + call amovs (a, c, npix) + case 2: + do i = 1, npix + c[i] = a[i] ** 2 + case 3: + do i = 1, npix + c[i] = a[i] ** 3 + case 4: + do i = 1, npix + c[i] = a[i] ** 4 + default: + do i = 1, npix + c[i] = a[i] ** b + } +end diff --git a/sys/vops/lz/apowkx.x b/sys/vops/lz/apowkx.x new file mode 100644 index 00000000..461353be --- /dev/null +++ b/sys/vops/lz/apowkx.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOWK -- Compute a ** b, where b is a constant of type INT (generic). + +procedure apowkx (a, b, c, npix) + +complex a[ARB], c[ARB] +int b +int npix, i + +begin + # Optimize the code for the various special cases. We assume that the + # compiler is intelligent enough to recognize the special cases if the + # power is expressed as an integer constant. + + switch (b) { + case 0: + call amovkx ((1,1), c, npix) + case 1: + call amovx (a, c, npix) + case 2: + do i = 1, npix + c[i] = a[i] ** 2 + case 3: + do i = 1, npix + c[i] = a[i] ** 3 + case 4: + do i = 1, npix + c[i] = a[i] ** 4 + default: + do i = 1, npix + c[i] = a[i] ** b + } +end diff --git a/sys/vops/lz/apowl.x b/sys/vops/lz/apowl.x new file mode 100644 index 00000000..28cd171f --- /dev/null +++ b/sys/vops/lz/apowl.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOW -- Compute a ** b, where b is of type INT (generic). + +procedure apowl (a, b, c, npix) + +long a[ARB], c[ARB] +int b[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** b[i] +end diff --git a/sys/vops/lz/apowr.x b/sys/vops/lz/apowr.x new file mode 100644 index 00000000..7d80443f --- /dev/null +++ b/sys/vops/lz/apowr.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOW -- Compute a ** b, where b is of type INT (generic). + +procedure apowr (a, b, c, npix) + +real a[ARB], c[ARB] +int b[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** b[i] +end diff --git a/sys/vops/lz/apows.x b/sys/vops/lz/apows.x new file mode 100644 index 00000000..de128595 --- /dev/null +++ b/sys/vops/lz/apows.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOW -- Compute a ** b, where b is of type INT (generic). + +procedure apows (a, b, c, npix) + +short a[ARB], c[ARB] +int b[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** b[i] +end diff --git a/sys/vops/lz/apowx.x b/sys/vops/lz/apowx.x new file mode 100644 index 00000000..77f7814d --- /dev/null +++ b/sys/vops/lz/apowx.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# APOW -- Compute a ** b, where b is of type INT (generic). + +procedure apowx (a, b, c, npix) + +complex a[ARB], c[ARB] +int b[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] ** b[i] +end diff --git a/sys/vops/lz/aravd.x b/sys/vops/lz/aravd.x new file mode 100644 index 00000000..7b454fd3 --- /dev/null +++ b/sys/vops/lz/aravd.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ARAV -- Compute the mean and standard deviation of a sample array by +# iteratively rejecting points further than KSIG from the mean. If the +# value of KSIG is given as 0.0, a cutoff value will be automatically +# calculated from the standard deviation and number of points in the sample. +# The number of pixels remaining in the sample upon termination is returned +# as the function value. + +int procedure aravd (a, npix, mean, sigma, ksig) + +double a[ARB] # input data array +double mean, sigma, ksig, deviation, lcut, hcut, lgpx +int npix, ngpix, old_ngpix, awvgd() + +begin + lcut = -MAX_REAL # no rejection to start + hcut = MAX_REAL + ngpix = MAX_INT + + # Iteratively compute mean, sigma and reject outliers until no + # more pixels are rejected, or until there are no more pixels. + + repeat { + old_ngpix = ngpix + ngpix = awvgd (a, npix, mean, sigma, lcut, hcut) + if (ngpix <= 1 || sigma <= EPSILOND) + break + + if (ksig == 0.0) { # Chauvenet's relation + lgpx = log10 (real(ngpix)) + deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma + } else + deviation = sigma * abs(ksig) + + lcut = mean - deviation # compute window + hcut = mean + deviation + + } until (ngpix >= old_ngpix) + + return (ngpix) +end diff --git a/sys/vops/lz/aravi.x b/sys/vops/lz/aravi.x new file mode 100644 index 00000000..865e4ecb --- /dev/null +++ b/sys/vops/lz/aravi.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ARAV -- Compute the mean and standard deviation of a sample array by +# iteratively rejecting points further than KSIG from the mean. If the +# value of KSIG is given as 0.0, a cutoff value will be automatically +# calculated from the standard deviation and number of points in the sample. +# The number of pixels remaining in the sample upon termination is returned +# as the function value. + +int procedure aravi (a, npix, mean, sigma, ksig) + +int a[ARB] # input data array +real mean, sigma, ksig, deviation, lcut, hcut, lgpx +int npix, ngpix, old_ngpix, awvgi() + +begin + lcut = -MAX_REAL # no rejection to start + hcut = MAX_REAL + ngpix = MAX_INT + + # Iteratively compute mean, sigma and reject outliers until no + # more pixels are rejected, or until there are no more pixels. + + repeat { + old_ngpix = ngpix + ngpix = awvgi (a, npix, mean, sigma, lcut, hcut) + if (ngpix <= 1 || sigma <= EPSILONR) + break + + if (ksig == 0.0) { # Chauvenet's relation + lgpx = log10 (real(ngpix)) + deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma + } else + deviation = sigma * abs(ksig) + + lcut = mean - deviation # compute window + hcut = mean + deviation + + } until (ngpix >= old_ngpix) + + return (ngpix) +end diff --git a/sys/vops/lz/aravl.x b/sys/vops/lz/aravl.x new file mode 100644 index 00000000..519cd1c8 --- /dev/null +++ b/sys/vops/lz/aravl.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ARAV -- Compute the mean and standard deviation of a sample array by +# iteratively rejecting points further than KSIG from the mean. If the +# value of KSIG is given as 0.0, a cutoff value will be automatically +# calculated from the standard deviation and number of points in the sample. +# The number of pixels remaining in the sample upon termination is returned +# as the function value. + +int procedure aravl (a, npix, mean, sigma, ksig) + +long a[ARB] # input data array +double mean, sigma, ksig, deviation, lcut, hcut, lgpx +int npix, ngpix, old_ngpix, awvgl() + +begin + lcut = -MAX_REAL # no rejection to start + hcut = MAX_REAL + ngpix = MAX_INT + + # Iteratively compute mean, sigma and reject outliers until no + # more pixels are rejected, or until there are no more pixels. + + repeat { + old_ngpix = ngpix + ngpix = awvgl (a, npix, mean, sigma, lcut, hcut) + if (ngpix <= 1 || sigma <= EPSILOND) + break + + if (ksig == 0.0) { # Chauvenet's relation + lgpx = log10 (real(ngpix)) + deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma + } else + deviation = sigma * abs(ksig) + + lcut = mean - deviation # compute window + hcut = mean + deviation + + } until (ngpix >= old_ngpix) + + return (ngpix) +end diff --git a/sys/vops/lz/aravr.x b/sys/vops/lz/aravr.x new file mode 100644 index 00000000..c3f0fb8f --- /dev/null +++ b/sys/vops/lz/aravr.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ARAV -- Compute the mean and standard deviation of a sample array by +# iteratively rejecting points further than KSIG from the mean. If the +# value of KSIG is given as 0.0, a cutoff value will be automatically +# calculated from the standard deviation and number of points in the sample. +# The number of pixels remaining in the sample upon termination is returned +# as the function value. + +int procedure aravr (a, npix, mean, sigma, ksig) + +real a[ARB] # input data array +real mean, sigma, ksig, deviation, lcut, hcut, lgpx +int npix, ngpix, old_ngpix, awvgr() + +begin + lcut = -MAX_REAL # no rejection to start + hcut = MAX_REAL + ngpix = MAX_INT + + # Iteratively compute mean, sigma and reject outliers until no + # more pixels are rejected, or until there are no more pixels. + + repeat { + old_ngpix = ngpix + ngpix = awvgr (a, npix, mean, sigma, lcut, hcut) + if (ngpix <= 1 || sigma <= EPSILONR) + break + + if (ksig == 0.0) { # Chauvenet's relation + lgpx = log10 (real(ngpix)) + deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma + } else + deviation = sigma * abs(ksig) + + lcut = mean - deviation # compute window + hcut = mean + deviation + + } until (ngpix >= old_ngpix) + + return (ngpix) +end diff --git a/sys/vops/lz/aravs.x b/sys/vops/lz/aravs.x new file mode 100644 index 00000000..6c734aed --- /dev/null +++ b/sys/vops/lz/aravs.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ARAV -- Compute the mean and standard deviation of a sample array by +# iteratively rejecting points further than KSIG from the mean. If the +# value of KSIG is given as 0.0, a cutoff value will be automatically +# calculated from the standard deviation and number of points in the sample. +# The number of pixels remaining in the sample upon termination is returned +# as the function value. + +int procedure aravs (a, npix, mean, sigma, ksig) + +short a[ARB] # input data array +real mean, sigma, ksig, deviation, lcut, hcut, lgpx +int npix, ngpix, old_ngpix, awvgs() + +begin + lcut = -MAX_REAL # no rejection to start + hcut = MAX_REAL + ngpix = MAX_INT + + # Iteratively compute mean, sigma and reject outliers until no + # more pixels are rejected, or until there are no more pixels. + + repeat { + old_ngpix = ngpix + ngpix = awvgs (a, npix, mean, sigma, lcut, hcut) + if (ngpix <= 1 || sigma <= EPSILONR) + break + + if (ksig == 0.0) { # Chauvenet's relation + lgpx = log10 (real(ngpix)) + deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma + } else + deviation = sigma * abs(ksig) + + lcut = mean - deviation # compute window + hcut = mean + deviation + + } until (ngpix >= old_ngpix) + + return (ngpix) +end diff --git a/sys/vops/lz/aravx.x b/sys/vops/lz/aravx.x new file mode 100644 index 00000000..92f7328c --- /dev/null +++ b/sys/vops/lz/aravx.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ARAV -- Compute the mean and standard deviation of a sample array by +# iteratively rejecting points further than KSIG from the mean. If the +# value of KSIG is given as 0.0, a cutoff value will be automatically +# calculated from the standard deviation and number of points in the sample. +# The number of pixels remaining in the sample upon termination is returned +# as the function value. + +int procedure aravx (a, npix, mean, sigma, ksig) + +complex a[ARB] # input data array +real mean, sigma, ksig, deviation, lcut, hcut, lgpx +int npix, ngpix, old_ngpix, awvgx() + +begin + lcut = -MAX_REAL # no rejection to start + hcut = MAX_REAL + ngpix = MAX_INT + + # Iteratively compute mean, sigma and reject outliers until no + # more pixels are rejected, or until there are no more pixels. + + repeat { + old_ngpix = ngpix + ngpix = awvgx (a, npix, mean, sigma, lcut, hcut) + if (ngpix <= 1 || sigma <= EPSILONR) + break + + if (ksig == 0.0) { # Chauvenet's relation + lgpx = log10 (real(ngpix)) + deviation = (lgpx * (-0.1042 * lgpx + 1.1695) + .8895) * sigma + } else + deviation = sigma * abs(ksig) + + lcut = mean - deviation # compute window + hcut = mean + deviation + + } until (ngpix >= old_ngpix) + + return (ngpix) +end diff --git a/sys/vops/lz/arcpd.x b/sys/vops/lz/arcpd.x new file mode 100644 index 00000000..095d50d3 --- /dev/null +++ b/sys/vops/lz/arcpd.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCP -- Reciprocal of a constant divided by a vector. No divide by zero +# checking is performed. + +procedure arcpd (a, b, c, npix) + +double a # constant numerator +double b[ARB] # vector denominator +double c[ARB] # output vector +int npix +int i + +begin + if (a == 0.0D0) { + call aclrd (c, npix) + } else if (a == 1.0D0) { + do i = 1, npix + c[i] = 1.0D0 / b[i] + } else { + do i = 1, npix + c[i] = a / b[i] + } +end diff --git a/sys/vops/lz/arcpi.x b/sys/vops/lz/arcpi.x new file mode 100644 index 00000000..193f35e1 --- /dev/null +++ b/sys/vops/lz/arcpi.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCP -- Reciprocal of a constant divided by a vector. No divide by zero +# checking is performed. + +procedure arcpi (a, b, c, npix) + +int a # constant numerator +int b[ARB] # vector denominator +int c[ARB] # output vector +int npix +int i + +begin + if (a == 0) { + call aclri (c, npix) + } else if (a == 1) { + do i = 1, npix + c[i] = 1 / b[i] + } else { + do i = 1, npix + c[i] = a / b[i] + } +end diff --git a/sys/vops/lz/arcpl.x b/sys/vops/lz/arcpl.x new file mode 100644 index 00000000..3f3c5b39 --- /dev/null +++ b/sys/vops/lz/arcpl.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCP -- Reciprocal of a constant divided by a vector. No divide by zero +# checking is performed. + +procedure arcpl (a, b, c, npix) + +long a # constant numerator +long b[ARB] # vector denominator +long c[ARB] # output vector +int npix +int i + +begin + if (a == 0) { + call aclrl (c, npix) + } else if (a == 1) { + do i = 1, npix + c[i] = 1 / b[i] + } else { + do i = 1, npix + c[i] = a / b[i] + } +end diff --git a/sys/vops/lz/arcpr.x b/sys/vops/lz/arcpr.x new file mode 100644 index 00000000..f52a1651 --- /dev/null +++ b/sys/vops/lz/arcpr.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCP -- Reciprocal of a constant divided by a vector. No divide by zero +# checking is performed. + +procedure arcpr (a, b, c, npix) + +real a # constant numerator +real b[ARB] # vector denominator +real c[ARB] # output vector +int npix +int i + +begin + if (a == 0.0) { + call aclrr (c, npix) + } else if (a == 1.0) { + do i = 1, npix + c[i] = 1.0 / b[i] + } else { + do i = 1, npix + c[i] = a / b[i] + } +end diff --git a/sys/vops/lz/arcps.x b/sys/vops/lz/arcps.x new file mode 100644 index 00000000..0e0f8056 --- /dev/null +++ b/sys/vops/lz/arcps.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCP -- Reciprocal of a constant divided by a vector. No divide by zero +# checking is performed. + +procedure arcps (a, b, c, npix) + +short a # constant numerator +short b[ARB] # vector denominator +short c[ARB] # output vector +int npix +int i + +begin + if (a == 0) { + call aclrs (c, npix) + } else if (a == 1) { + do i = 1, npix + c[i] = 1 / b[i] + } else { + do i = 1, npix + c[i] = a / b[i] + } +end diff --git a/sys/vops/lz/arcpx.x b/sys/vops/lz/arcpx.x new file mode 100644 index 00000000..626eb6a1 --- /dev/null +++ b/sys/vops/lz/arcpx.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCP -- Reciprocal of a constant divided by a vector. No divide by zero +# checking is performed. + +procedure arcpx (a, b, c, npix) + +complex a # constant numerator +complex b[ARB] # vector denominator +complex c[ARB] # output vector +int npix +int i + +begin + if (a == (0.0,0.0)) { + call aclrx (c, npix) + } else if (a == (1.0,1.0)) { + do i = 1, npix + c[i] = (1.0,1.0) / b[i] + } else { + do i = 1, npix + c[i] = a / b[i] + } +end diff --git a/sys/vops/lz/arczd.x b/sys/vops/lz/arczd.x new file mode 100644 index 00000000..4f5ad6f2 --- /dev/null +++ b/sys/vops/lz/arczd.x @@ -0,0 +1,47 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCZ -- Vector reciprocal with checking for zero divisors. If the result +# of a divide would be undefined a user supplied function is called to get the +# output pixel value. +# +# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used +# to check for an undefined divide, i.e., a divide by zero or a divide by a +# number small enough to cause floating point overflow. A better way to do +# this would be to provide a machine dependent version of this operator in +# host$as which catches the hardware exception rather than using a comparison. + +procedure arczd (a, b, c, npix, errfcn) + +double a # numerator +double b[ARB], c[ARB] # divisor, and output arrays +int npix # number of pixels +double errfcn() # user function, called on divide by zero + +int i +double divisor +double tol +extern errfcn() +errchk errfcn + +begin + if (a == 0.0D0) { + call aclrd (c, npix) + return + } + + tol = 1.0D-20 + + do i = 1, npix { + divisor = b[i] + # The following is most efficient when the data tends to be + # positive. + + if (divisor < tol) + if (divisor > -tol) { + c[i] = errfcn (a) + next + } + c[i] = a / divisor + + } +end diff --git a/sys/vops/lz/arczi.x b/sys/vops/lz/arczi.x new file mode 100644 index 00000000..ce679742 --- /dev/null +++ b/sys/vops/lz/arczi.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCZ -- Vector reciprocal with checking for zero divisors. If the result +# of a divide would be undefined a user supplied function is called to get the +# output pixel value. +# +# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used +# to check for an undefined divide, i.e., a divide by zero or a divide by a +# number small enough to cause floating point overflow. A better way to do +# this would be to provide a machine dependent version of this operator in +# host$as which catches the hardware exception rather than using a comparison. + +procedure arczi (a, b, c, npix, errfcn) + +int a # numerator +int b[ARB], c[ARB] # divisor, and output arrays +int npix # number of pixels +int errfcn() # user function, called on divide by zero + +int i +int divisor +extern errfcn() +errchk errfcn + +begin + if (a == 0) { + call aclri (c, npix) + return + } + + + do i = 1, npix { + divisor = b[i] + if (divisor == 0) + c[i] = errfcn (a) + else + c[i] = a / divisor + } +end diff --git a/sys/vops/lz/arczl.x b/sys/vops/lz/arczl.x new file mode 100644 index 00000000..b89e2cbe --- /dev/null +++ b/sys/vops/lz/arczl.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCZ -- Vector reciprocal with checking for zero divisors. If the result +# of a divide would be undefined a user supplied function is called to get the +# output pixel value. +# +# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used +# to check for an undefined divide, i.e., a divide by zero or a divide by a +# number small enough to cause floating point overflow. A better way to do +# this would be to provide a machine dependent version of this operator in +# host$as which catches the hardware exception rather than using a comparison. + +procedure arczl (a, b, c, npix, errfcn) + +long a # numerator +long b[ARB], c[ARB] # divisor, and output arrays +int npix # number of pixels +long errfcn() # user function, called on divide by zero + +int i +long divisor +extern errfcn() +errchk errfcn + +begin + if (a == 0) { + call aclrl (c, npix) + return + } + + + do i = 1, npix { + divisor = b[i] + if (divisor == 0) + c[i] = errfcn (a) + else + c[i] = a / divisor + } +end diff --git a/sys/vops/lz/arczr.x b/sys/vops/lz/arczr.x new file mode 100644 index 00000000..7c2e9fe2 --- /dev/null +++ b/sys/vops/lz/arczr.x @@ -0,0 +1,47 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCZ -- Vector reciprocal with checking for zero divisors. If the result +# of a divide would be undefined a user supplied function is called to get the +# output pixel value. +# +# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used +# to check for an undefined divide, i.e., a divide by zero or a divide by a +# number small enough to cause floating point overflow. A better way to do +# this would be to provide a machine dependent version of this operator in +# host$as which catches the hardware exception rather than using a comparison. + +procedure arczr (a, b, c, npix, errfcn) + +real a # numerator +real b[ARB], c[ARB] # divisor, and output arrays +int npix # number of pixels +real errfcn() # user function, called on divide by zero + +int i +real divisor +real tol +extern errfcn() +errchk errfcn + +begin + if (a == 0.0) { + call aclrr (c, npix) + return + } + + tol = 1.0E-20 + + do i = 1, npix { + divisor = b[i] + # The following is most efficient when the data tends to be + # positive. + + if (divisor < tol) + if (divisor > -tol) { + c[i] = errfcn (a) + next + } + c[i] = a / divisor + + } +end diff --git a/sys/vops/lz/arczs.x b/sys/vops/lz/arczs.x new file mode 100644 index 00000000..4216d38d --- /dev/null +++ b/sys/vops/lz/arczs.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCZ -- Vector reciprocal with checking for zero divisors. If the result +# of a divide would be undefined a user supplied function is called to get the +# output pixel value. +# +# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used +# to check for an undefined divide, i.e., a divide by zero or a divide by a +# number small enough to cause floating point overflow. A better way to do +# this would be to provide a machine dependent version of this operator in +# host$as which catches the hardware exception rather than using a comparison. + +procedure arczs (a, b, c, npix, errfcn) + +short a # numerator +short b[ARB], c[ARB] # divisor, and output arrays +int npix # number of pixels +short errfcn() # user function, called on divide by zero + +int i +short divisor +extern errfcn() +errchk errfcn + +begin + if (a == 0) { + call aclrs (c, npix) + return + } + + + do i = 1, npix { + divisor = b[i] + if (divisor == 0) + c[i] = errfcn (a) + else + c[i] = a / divisor + } +end diff --git a/sys/vops/lz/arczx.x b/sys/vops/lz/arczx.x new file mode 100644 index 00000000..ec23595e --- /dev/null +++ b/sys/vops/lz/arczx.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARCZ -- Vector reciprocal with checking for zero divisors. If the result +# of a divide would be undefined a user supplied function is called to get the +# output pixel value. +# +# NOTE: in the interests of simplicity a somewhat arbitrary tolerance is used +# to check for an undefined divide, i.e., a divide by zero or a divide by a +# number small enough to cause floating point overflow. A better way to do +# this would be to provide a machine dependent version of this operator in +# host$as which catches the hardware exception rather than using a comparison. + +procedure arczx (a, b, c, npix, errfcn) + +complex a # numerator +complex b[ARB], c[ARB] # divisor, and output arrays +int npix # number of pixels +complex errfcn() # user function, called on divide by zero + +int i +complex divisor +extern errfcn() +errchk errfcn + +begin + if (a == (0.0,0.0)) { + call aclrx (c, npix) + return + } + + + do i = 1, npix { + divisor = b[i] + if (divisor == (0.0,0.0)) + c[i] = errfcn (a) + else + c[i] = a / divisor + } +end diff --git a/sys/vops/lz/argtd.x b/sys/vops/lz/argtd.x new file mode 100644 index 00000000..bf12e17c --- /dev/null +++ b/sys/vops/lz/argtd.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARGT -- Replace if greater than. If A[i] is greater than CEIL replace by +# NEWVAL. + +procedure argtd (a, npix, ceil, newval) + +double a[ARB] +int npix +double ceil, newval +int i + +begin + + do i = 1, npix + if (a[i] > ceil) + a[i] = newval +end diff --git a/sys/vops/lz/argti.x b/sys/vops/lz/argti.x new file mode 100644 index 00000000..dffdce17 --- /dev/null +++ b/sys/vops/lz/argti.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARGT -- Replace if greater than. If A[i] is greater than CEIL replace by +# NEWVAL. + +procedure argti (a, npix, ceil, newval) + +int a[ARB] +int npix +int ceil, newval +int i + +begin + + do i = 1, npix + if (a[i] > ceil) + a[i] = newval +end diff --git a/sys/vops/lz/argtl.x b/sys/vops/lz/argtl.x new file mode 100644 index 00000000..e776573c --- /dev/null +++ b/sys/vops/lz/argtl.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARGT -- Replace if greater than. If A[i] is greater than CEIL replace by +# NEWVAL. + +procedure argtl (a, npix, ceil, newval) + +long a[ARB] +int npix +long ceil, newval +int i + +begin + + do i = 1, npix + if (a[i] > ceil) + a[i] = newval +end diff --git a/sys/vops/lz/argtr.x b/sys/vops/lz/argtr.x new file mode 100644 index 00000000..5ab107f7 --- /dev/null +++ b/sys/vops/lz/argtr.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARGT -- Replace if greater than. If A[i] is greater than CEIL replace by +# NEWVAL. + +procedure argtr (a, npix, ceil, newval) + +real a[ARB] +int npix +real ceil, newval +int i + +begin + + do i = 1, npix + if (a[i] > ceil) + a[i] = newval +end diff --git a/sys/vops/lz/argts.x b/sys/vops/lz/argts.x new file mode 100644 index 00000000..815f753f --- /dev/null +++ b/sys/vops/lz/argts.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARGT -- Replace if greater than. If A[i] is greater than CEIL replace by +# NEWVAL. + +procedure argts (a, npix, ceil, newval) + +short a[ARB] +int npix +short ceil, newval +int i + +begin + + do i = 1, npix + if (a[i] > ceil) + a[i] = newval +end diff --git a/sys/vops/lz/argtx.x b/sys/vops/lz/argtx.x new file mode 100644 index 00000000..53253e01 --- /dev/null +++ b/sys/vops/lz/argtx.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARGT -- Replace if greater than. If A[i] is greater than CEIL replace by +# NEWVAL. + +procedure argtx (a, npix, ceil, newval) + +complex a[ARB] +int npix +complex ceil, newval +int i +real abs_ceil + +begin + abs_ceil = abs (ceil) + + do i = 1, npix + if (abs (a[i]) > abs_ceil) + a[i] = newval +end diff --git a/sys/vops/lz/arltd.x b/sys/vops/lz/arltd.x new file mode 100644 index 00000000..62693331 --- /dev/null +++ b/sys/vops/lz/arltd.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARLT -- Replace if less than. If A[i] is less than FLOOR replace by NEWVAL. + +procedure arltd (a, npix, floor, newval) + +double a[ARB] +int npix +double floor, newval +int i + +begin + + do i = 1, npix + if (a[i] < floor) + a[i] = newval +end diff --git a/sys/vops/lz/arlti.x b/sys/vops/lz/arlti.x new file mode 100644 index 00000000..6b8ae086 --- /dev/null +++ b/sys/vops/lz/arlti.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARLT -- Replace if less than. If A[i] is less than FLOOR replace by NEWVAL. + +procedure arlti (a, npix, floor, newval) + +int a[ARB] +int npix +int floor, newval +int i + +begin + + do i = 1, npix + if (a[i] < floor) + a[i] = newval +end diff --git a/sys/vops/lz/arltl.x b/sys/vops/lz/arltl.x new file mode 100644 index 00000000..4bda96c3 --- /dev/null +++ b/sys/vops/lz/arltl.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARLT -- Replace if less than. If A[i] is less than FLOOR replace by NEWVAL. + +procedure arltl (a, npix, floor, newval) + +long a[ARB] +int npix +long floor, newval +int i + +begin + + do i = 1, npix + if (a[i] < floor) + a[i] = newval +end diff --git a/sys/vops/lz/arltr.x b/sys/vops/lz/arltr.x new file mode 100644 index 00000000..3b419556 --- /dev/null +++ b/sys/vops/lz/arltr.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARLT -- Replace if less than. If A[i] is less than FLOOR replace by NEWVAL. + +procedure arltr (a, npix, floor, newval) + +real a[ARB] +int npix +real floor, newval +int i + +begin + + do i = 1, npix + if (a[i] < floor) + a[i] = newval +end diff --git a/sys/vops/lz/arlts.x b/sys/vops/lz/arlts.x new file mode 100644 index 00000000..ca4e0582 --- /dev/null +++ b/sys/vops/lz/arlts.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARLT -- Replace if less than. If A[i] is less than FLOOR replace by NEWVAL. + +procedure arlts (a, npix, floor, newval) + +short a[ARB] +int npix +short floor, newval +int i + +begin + + do i = 1, npix + if (a[i] < floor) + a[i] = newval +end diff --git a/sys/vops/lz/arltx.x b/sys/vops/lz/arltx.x new file mode 100644 index 00000000..8ea55d5f --- /dev/null +++ b/sys/vops/lz/arltx.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ARLT -- Replace if less than. If A[i] is less than FLOOR replace by NEWVAL. + +procedure arltx (a, npix, floor, newval) + +complex a[ARB] +int npix +complex floor, newval +int i +real abs_floor + +begin + abs_floor = abs (floor) + + do i = 1, npix + if (abs (a[i]) < abs_floor) + a[i] = newval +end diff --git a/sys/vops/lz/aselc.x b/sys/vops/lz/aselc.x new file mode 100644 index 00000000..eeed8930 --- /dev/null +++ b/sys/vops/lz/aselc.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASEL -- Vector select element. The output vector is formed by taking +# successive pixels from either of the two input vectors, based on the value +# of the integer (boolean) selection vectors. Used to implement vector +# conditional expressions. + +procedure aselc (a, b, c, sel, npix) + +char a[ARB], b[ARB], c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b[i] +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/aseld.x b/sys/vops/lz/aseld.x new file mode 100644 index 00000000..79758363 --- /dev/null +++ b/sys/vops/lz/aseld.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASEL -- Vector select element. The output vector is formed by taking +# successive pixels from either of the two input vectors, based on the value +# of the integer (boolean) selection vectors. Used to implement vector +# conditional expressions. + +procedure aseld (a, b, c, sel, npix) + +double a[ARB], b[ARB], c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b[i] +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/aseli.x b/sys/vops/lz/aseli.x new file mode 100644 index 00000000..c4a8a211 --- /dev/null +++ b/sys/vops/lz/aseli.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASEL -- Vector select element. The output vector is formed by taking +# successive pixels from either of the two input vectors, based on the value +# of the integer (boolean) selection vectors. Used to implement vector +# conditional expressions. + +procedure aseli (a, b, c, sel, npix) + +int a[ARB], b[ARB], c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b[i] +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/aselkc.x b/sys/vops/lz/aselkc.x new file mode 100644 index 00000000..28b5d4a2 --- /dev/null +++ b/sys/vops/lz/aselkc.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASELK -- Vector/constant select element. The output vector is formed by +# taking successive pixels from either of the input vector or a constant, based +# on the value of the integer (boolean) selection vectors. Used to implement +# vector conditional expressions. + +procedure aselkc (a, b, c, sel, npix) + +char a[ARB], b, c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/aselkd.x b/sys/vops/lz/aselkd.x new file mode 100644 index 00000000..f0ad7dae --- /dev/null +++ b/sys/vops/lz/aselkd.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASELK -- Vector/constant select element. The output vector is formed by +# taking successive pixels from either of the input vector or a constant, based +# on the value of the integer (boolean) selection vectors. Used to implement +# vector conditional expressions. + +procedure aselkd (a, b, c, sel, npix) + +double a[ARB], b, c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/aselki.x b/sys/vops/lz/aselki.x new file mode 100644 index 00000000..a56737ab --- /dev/null +++ b/sys/vops/lz/aselki.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASELK -- Vector/constant select element. The output vector is formed by +# taking successive pixels from either of the input vector or a constant, based +# on the value of the integer (boolean) selection vectors. Used to implement +# vector conditional expressions. + +procedure aselki (a, b, c, sel, npix) + +int a[ARB], b, c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/aselkl.x b/sys/vops/lz/aselkl.x new file mode 100644 index 00000000..2fbf6b23 --- /dev/null +++ b/sys/vops/lz/aselkl.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASELK -- Vector/constant select element. The output vector is formed by +# taking successive pixels from either of the input vector or a constant, based +# on the value of the integer (boolean) selection vectors. Used to implement +# vector conditional expressions. + +procedure aselkl (a, b, c, sel, npix) + +long a[ARB], b, c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/aselkr.x b/sys/vops/lz/aselkr.x new file mode 100644 index 00000000..702000b3 --- /dev/null +++ b/sys/vops/lz/aselkr.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASELK -- Vector/constant select element. The output vector is formed by +# taking successive pixels from either of the input vector or a constant, based +# on the value of the integer (boolean) selection vectors. Used to implement +# vector conditional expressions. + +procedure aselkr (a, b, c, sel, npix) + +real a[ARB], b, c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/aselks.x b/sys/vops/lz/aselks.x new file mode 100644 index 00000000..59891f15 --- /dev/null +++ b/sys/vops/lz/aselks.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASELK -- Vector/constant select element. The output vector is formed by +# taking successive pixels from either of the input vector or a constant, based +# on the value of the integer (boolean) selection vectors. Used to implement +# vector conditional expressions. + +procedure aselks (a, b, c, sel, npix) + +short a[ARB], b, c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/aselkx.x b/sys/vops/lz/aselkx.x new file mode 100644 index 00000000..4a4de962 --- /dev/null +++ b/sys/vops/lz/aselkx.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASELK -- Vector/constant select element. The output vector is formed by +# taking successive pixels from either of the input vector or a constant, based +# on the value of the integer (boolean) selection vectors. Used to implement +# vector conditional expressions. + +procedure aselkx (a, b, c, sel, npix) + +complex a[ARB], b, c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b +end diff --git a/sys/vops/lz/asell.x b/sys/vops/lz/asell.x new file mode 100644 index 00000000..5b7e08a7 --- /dev/null +++ b/sys/vops/lz/asell.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASEL -- Vector select element. The output vector is formed by taking +# successive pixels from either of the two input vectors, based on the value +# of the integer (boolean) selection vectors. Used to implement vector +# conditional expressions. + +procedure asell (a, b, c, sel, npix) + +long a[ARB], b[ARB], c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b[i] +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/aselr.x b/sys/vops/lz/aselr.x new file mode 100644 index 00000000..3a5f7f1b --- /dev/null +++ b/sys/vops/lz/aselr.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASEL -- Vector select element. The output vector is formed by taking +# successive pixels from either of the two input vectors, based on the value +# of the integer (boolean) selection vectors. Used to implement vector +# conditional expressions. + +procedure aselr (a, b, c, sel, npix) + +real a[ARB], b[ARB], c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b[i] +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/asels.x b/sys/vops/lz/asels.x new file mode 100644 index 00000000..b2118ba8 --- /dev/null +++ b/sys/vops/lz/asels.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASEL -- Vector select element. The output vector is formed by taking +# successive pixels from either of the two input vectors, based on the value +# of the integer (boolean) selection vectors. Used to implement vector +# conditional expressions. + +procedure asels (a, b, c, sel, npix) + +short a[ARB], b[ARB], c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b[i] +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/aselx.x b/sys/vops/lz/aselx.x new file mode 100644 index 00000000..1bd02e9a --- /dev/null +++ b/sys/vops/lz/aselx.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASEL -- Vector select element. The output vector is formed by taking +# successive pixels from either of the two input vectors, based on the value +# of the integer (boolean) selection vectors. Used to implement vector +# conditional expressions. + +procedure aselx (a, b, c, sel, npix) + +complex a[ARB], b[ARB], c[ARB] +int sel[ARB] # IF sel[i] THEN a[i] ELSE b[i] +int npix +int i + +begin + do i = 1, npix + if (sel[i] != 0) + c[i] = a[i] + else + c[i] = b[i] +end diff --git a/sys/vops/lz/asokc.x b/sys/vops/lz/asokc.x new file mode 100644 index 00000000..794252f2 --- /dev/null +++ b/sys/vops/lz/asokc.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ASOK -- Select the Kth smallest element from a vector. The algorithm used +# is selection by tail recursion (Gonnet 1984). In each iteration a pivot key +# is selected (somewhat arbitrarily) from the array. The array is then split +# into two subarrays, those with key values less than or equal to the pivot key +# and those with values greater than the pivot. The size of the two subarrays +# determines which contains the median value, and the process is repeated +# on that subarray, and so on until all of the elements of the subarray +# are equal, e.g., there is only one element left in the subarray. For a +# randomly ordered array the expected running time is O(3.38N). The selection +# is carried out in place, leaving the array in a partially ordered state. +# +# N.B.: Behaviour is O(N) if the input array is sorted. +# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and +# maximum values, are more efficiently handled by ALIM which is O(2N). +# +# Jul99 - The above algorithm was found to be pathologically slow in cases +# where many or all elements of the array are equal. The version of the +# algorithm below, from Wirth, appears to avoid this problem. + +char procedure asokc (a, npix, ksel) + +char a[ARB] # input array +int npix # number of pixels +int ksel # element to be selected + +int lo, up, i, j, k, dummy +char temp, wtemp + +begin + lo = 1 + up = npix + k = max (lo, min (up, ksel)) + + # while (lo < up) + do dummy = 1, MAX_INT { + if (! (lo < up)) + break + + temp = a[k]; i = lo; j = up + + repeat { + while (a[i] < temp) + i = i + 1 + while (temp < a[j]) + j = j - 1 + if (i <= j) { + wtemp = a[i]; a[i] = a[j]; a[j] = wtemp + i = i + 1; j = j - 1 + } + } until (i > j) + + if (j < k) + lo = i + if (k < i) + up = j + } + + return (a[k]) +end diff --git a/sys/vops/lz/asokd.x b/sys/vops/lz/asokd.x new file mode 100644 index 00000000..54627469 --- /dev/null +++ b/sys/vops/lz/asokd.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ASOK -- Select the Kth smallest element from a vector. The algorithm used +# is selection by tail recursion (Gonnet 1984). In each iteration a pivot key +# is selected (somewhat arbitrarily) from the array. The array is then split +# into two subarrays, those with key values less than or equal to the pivot key +# and those with values greater than the pivot. The size of the two subarrays +# determines which contains the median value, and the process is repeated +# on that subarray, and so on until all of the elements of the subarray +# are equal, e.g., there is only one element left in the subarray. For a +# randomly ordered array the expected running time is O(3.38N). The selection +# is carried out in place, leaving the array in a partially ordered state. +# +# N.B.: Behaviour is O(N) if the input array is sorted. +# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and +# maximum values, are more efficiently handled by ALIM which is O(2N). +# +# Jul99 - The above algorithm was found to be pathologically slow in cases +# where many or all elements of the array are equal. The version of the +# algorithm below, from Wirth, appears to avoid this problem. + +double procedure asokd (a, npix, ksel) + +double a[ARB] # input array +int npix # number of pixels +int ksel # element to be selected + +int lo, up, i, j, k, dummy +double temp, wtemp + +begin + lo = 1 + up = npix + k = max (lo, min (up, ksel)) + + # while (lo < up) + do dummy = 1, MAX_INT { + if (! (lo < up)) + break + + temp = a[k]; i = lo; j = up + + repeat { + while (a[i] < temp) + i = i + 1 + while (temp < a[j]) + j = j - 1 + if (i <= j) { + wtemp = a[i]; a[i] = a[j]; a[j] = wtemp + i = i + 1; j = j - 1 + } + } until (i > j) + + if (j < k) + lo = i + if (k < i) + up = j + } + + return (a[k]) +end diff --git a/sys/vops/lz/asoki.x b/sys/vops/lz/asoki.x new file mode 100644 index 00000000..dd579ac2 --- /dev/null +++ b/sys/vops/lz/asoki.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ASOK -- Select the Kth smallest element from a vector. The algorithm used +# is selection by tail recursion (Gonnet 1984). In each iteration a pivot key +# is selected (somewhat arbitrarily) from the array. The array is then split +# into two subarrays, those with key values less than or equal to the pivot key +# and those with values greater than the pivot. The size of the two subarrays +# determines which contains the median value, and the process is repeated +# on that subarray, and so on until all of the elements of the subarray +# are equal, e.g., there is only one element left in the subarray. For a +# randomly ordered array the expected running time is O(3.38N). The selection +# is carried out in place, leaving the array in a partially ordered state. +# +# N.B.: Behaviour is O(N) if the input array is sorted. +# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and +# maximum values, are more efficiently handled by ALIM which is O(2N). +# +# Jul99 - The above algorithm was found to be pathologically slow in cases +# where many or all elements of the array are equal. The version of the +# algorithm below, from Wirth, appears to avoid this problem. + +int procedure asoki (a, npix, ksel) + +int a[ARB] # input array +int npix # number of pixels +int ksel # element to be selected + +int lo, up, i, j, k, dummy +int temp, wtemp + +begin + lo = 1 + up = npix + k = max (lo, min (up, ksel)) + + # while (lo < up) + do dummy = 1, MAX_INT { + if (! (lo < up)) + break + + temp = a[k]; i = lo; j = up + + repeat { + while (a[i] < temp) + i = i + 1 + while (temp < a[j]) + j = j - 1 + if (i <= j) { + wtemp = a[i]; a[i] = a[j]; a[j] = wtemp + i = i + 1; j = j - 1 + } + } until (i > j) + + if (j < k) + lo = i + if (k < i) + up = j + } + + return (a[k]) +end diff --git a/sys/vops/lz/asokl.x b/sys/vops/lz/asokl.x new file mode 100644 index 00000000..37adff9c --- /dev/null +++ b/sys/vops/lz/asokl.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ASOK -- Select the Kth smallest element from a vector. The algorithm used +# is selection by tail recursion (Gonnet 1984). In each iteration a pivot key +# is selected (somewhat arbitrarily) from the array. The array is then split +# into two subarrays, those with key values less than or equal to the pivot key +# and those with values greater than the pivot. The size of the two subarrays +# determines which contains the median value, and the process is repeated +# on that subarray, and so on until all of the elements of the subarray +# are equal, e.g., there is only one element left in the subarray. For a +# randomly ordered array the expected running time is O(3.38N). The selection +# is carried out in place, leaving the array in a partially ordered state. +# +# N.B.: Behaviour is O(N) if the input array is sorted. +# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and +# maximum values, are more efficiently handled by ALIM which is O(2N). +# +# Jul99 - The above algorithm was found to be pathologically slow in cases +# where many or all elements of the array are equal. The version of the +# algorithm below, from Wirth, appears to avoid this problem. + +long procedure asokl (a, npix, ksel) + +long a[ARB] # input array +int npix # number of pixels +int ksel # element to be selected + +int lo, up, i, j, k, dummy +long temp, wtemp + +begin + lo = 1 + up = npix + k = max (lo, min (up, ksel)) + + # while (lo < up) + do dummy = 1, MAX_INT { + if (! (lo < up)) + break + + temp = a[k]; i = lo; j = up + + repeat { + while (a[i] < temp) + i = i + 1 + while (temp < a[j]) + j = j - 1 + if (i <= j) { + wtemp = a[i]; a[i] = a[j]; a[j] = wtemp + i = i + 1; j = j - 1 + } + } until (i > j) + + if (j < k) + lo = i + if (k < i) + up = j + } + + return (a[k]) +end diff --git a/sys/vops/lz/asokr.x b/sys/vops/lz/asokr.x new file mode 100644 index 00000000..420eaf65 --- /dev/null +++ b/sys/vops/lz/asokr.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ASOK -- Select the Kth smallest element from a vector. The algorithm used +# is selection by tail recursion (Gonnet 1984). In each iteration a pivot key +# is selected (somewhat arbitrarily) from the array. The array is then split +# into two subarrays, those with key values less than or equal to the pivot key +# and those with values greater than the pivot. The size of the two subarrays +# determines which contains the median value, and the process is repeated +# on that subarray, and so on until all of the elements of the subarray +# are equal, e.g., there is only one element left in the subarray. For a +# randomly ordered array the expected running time is O(3.38N). The selection +# is carried out in place, leaving the array in a partially ordered state. +# +# N.B.: Behaviour is O(N) if the input array is sorted. +# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and +# maximum values, are more efficiently handled by ALIM which is O(2N). +# +# Jul99 - The above algorithm was found to be pathologically slow in cases +# where many or all elements of the array are equal. The version of the +# algorithm below, from Wirth, appears to avoid this problem. + +real procedure asokr (a, npix, ksel) + +real a[ARB] # input array +int npix # number of pixels +int ksel # element to be selected + +int lo, up, i, j, k, dummy +real temp, wtemp + +begin + lo = 1 + up = npix + k = max (lo, min (up, ksel)) + + # while (lo < up) + do dummy = 1, MAX_INT { + if (! (lo < up)) + break + + temp = a[k]; i = lo; j = up + + repeat { + while (a[i] < temp) + i = i + 1 + while (temp < a[j]) + j = j - 1 + if (i <= j) { + wtemp = a[i]; a[i] = a[j]; a[j] = wtemp + i = i + 1; j = j - 1 + } + } until (i > j) + + if (j < k) + lo = i + if (k < i) + up = j + } + + return (a[k]) +end diff --git a/sys/vops/lz/asoks.x b/sys/vops/lz/asoks.x new file mode 100644 index 00000000..a92f4015 --- /dev/null +++ b/sys/vops/lz/asoks.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ASOK -- Select the Kth smallest element from a vector. The algorithm used +# is selection by tail recursion (Gonnet 1984). In each iteration a pivot key +# is selected (somewhat arbitrarily) from the array. The array is then split +# into two subarrays, those with key values less than or equal to the pivot key +# and those with values greater than the pivot. The size of the two subarrays +# determines which contains the median value, and the process is repeated +# on that subarray, and so on until all of the elements of the subarray +# are equal, e.g., there is only one element left in the subarray. For a +# randomly ordered array the expected running time is O(3.38N). The selection +# is carried out in place, leaving the array in a partially ordered state. +# +# N.B.: Behaviour is O(N) if the input array is sorted. +# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and +# maximum values, are more efficiently handled by ALIM which is O(2N). +# +# Jul99 - The above algorithm was found to be pathologically slow in cases +# where many or all elements of the array are equal. The version of the +# algorithm below, from Wirth, appears to avoid this problem. + +short procedure asoks (a, npix, ksel) + +short a[ARB] # input array +int npix # number of pixels +int ksel # element to be selected + +int lo, up, i, j, k, dummy +short temp, wtemp + +begin + lo = 1 + up = npix + k = max (lo, min (up, ksel)) + + # while (lo < up) + do dummy = 1, MAX_INT { + if (! (lo < up)) + break + + temp = a[k]; i = lo; j = up + + repeat { + while (a[i] < temp) + i = i + 1 + while (temp < a[j]) + j = j - 1 + if (i <= j) { + wtemp = a[i]; a[i] = a[j]; a[j] = wtemp + i = i + 1; j = j - 1 + } + } until (i > j) + + if (j < k) + lo = i + if (k < i) + up = j + } + + return (a[k]) +end diff --git a/sys/vops/lz/asokx.x b/sys/vops/lz/asokx.x new file mode 100644 index 00000000..7528714a --- /dev/null +++ b/sys/vops/lz/asokx.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# ASOK -- Select the Kth smallest element from a vector. The algorithm used +# is selection by tail recursion (Gonnet 1984). In each iteration a pivot key +# is selected (somewhat arbitrarily) from the array. The array is then split +# into two subarrays, those with key values less than or equal to the pivot key +# and those with values greater than the pivot. The size of the two subarrays +# determines which contains the median value, and the process is repeated +# on that subarray, and so on until all of the elements of the subarray +# are equal, e.g., there is only one element left in the subarray. For a +# randomly ordered array the expected running time is O(3.38N). The selection +# is carried out in place, leaving the array in a partially ordered state. +# +# N.B.: Behaviour is O(N) if the input array is sorted. +# N.B.: The cases ksel=1 and ksel=npix, i.e., selection of the minimum and +# maximum values, are more efficiently handled by ALIM which is O(2N). +# +# Jul99 - The above algorithm was found to be pathologically slow in cases +# where many or all elements of the array are equal. The version of the +# algorithm below, from Wirth, appears to avoid this problem. + +complex procedure asokx (a, npix, ksel) + +complex a[ARB] # input array +int npix # number of pixels +int ksel # element to be selected + +int lo, up, i, j, k, dummy +complex temp, wtemp +real abs_temp + +begin + lo = 1 + up = npix + k = max (lo, min (up, ksel)) + + # while (lo < up) + do dummy = 1, MAX_INT { + if (! (lo < up)) + break + + temp = a[k]; i = lo; j = up + abs_temp = abs (temp) + + repeat { + while (abs (a[i]) < abs_temp) + i = i + 1 + while (abs_temp < abs (a[j])) + j = j - 1 + if (i <= j) { + wtemp = a[i]; a[i] = a[j]; a[j] = wtemp + i = i + 1; j = j - 1 + } + } until (i > j) + + if (j < k) + lo = i + if (k < i) + up = j + } + + return (a[k]) +end diff --git a/sys/vops/lz/asqrd.x b/sys/vops/lz/asqrd.x new file mode 100644 index 00000000..e6cf3f70 --- /dev/null +++ b/sys/vops/lz/asqrd.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASQR -- Compute the square root of a vector (generic). If the square root +# is undefined (x < 0) a user supplied function is called to compute the value. + +procedure asqrd (a, b, npix, errfcn) + +double a[ARB], b[ARB] +int npix, i +extern errfcn() +double errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] < 0) + b[i] = errfcn (a[i]) + else + { + b[i] = sqrt (a[i]) + } + } +end diff --git a/sys/vops/lz/asqri.x b/sys/vops/lz/asqri.x new file mode 100644 index 00000000..c68c64f4 --- /dev/null +++ b/sys/vops/lz/asqri.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASQR -- Compute the square root of a vector (generic). If the square root +# is undefined (x < 0) a user supplied function is called to compute the value. + +procedure asqri (a, b, npix, errfcn) + +int a[ARB], b[ARB] +int npix, i +extern errfcn() +int errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] < 0) + b[i] = errfcn (a[i]) + else + { + b[i] = sqrt (real (a[i])) + } + } +end diff --git a/sys/vops/lz/asqrl.x b/sys/vops/lz/asqrl.x new file mode 100644 index 00000000..3b0d23f0 --- /dev/null +++ b/sys/vops/lz/asqrl.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASQR -- Compute the square root of a vector (generic). If the square root +# is undefined (x < 0) a user supplied function is called to compute the value. + +procedure asqrl (a, b, npix, errfcn) + +long a[ARB], b[ARB] +int npix, i +extern errfcn() +long errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] < 0) + b[i] = errfcn (a[i]) + else + { + b[i] = sqrt (double (a[i])) + } + } +end diff --git a/sys/vops/lz/asqrr.x b/sys/vops/lz/asqrr.x new file mode 100644 index 00000000..a18b21d2 --- /dev/null +++ b/sys/vops/lz/asqrr.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASQR -- Compute the square root of a vector (generic). If the square root +# is undefined (x < 0) a user supplied function is called to compute the value. + +procedure asqrr (a, b, npix, errfcn) + +real a[ARB], b[ARB] +int npix, i +extern errfcn() +real errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] < 0) + b[i] = errfcn (a[i]) + else + { + b[i] = sqrt (a[i]) + } + } +end diff --git a/sys/vops/lz/asqrs.x b/sys/vops/lz/asqrs.x new file mode 100644 index 00000000..5a1d6532 --- /dev/null +++ b/sys/vops/lz/asqrs.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASQR -- Compute the square root of a vector (generic). If the square root +# is undefined (x < 0) a user supplied function is called to compute the value. + +procedure asqrs (a, b, npix, errfcn) + +short a[ARB], b[ARB] +int npix, i +extern errfcn() +short errfcn() +errchk errfcn + +begin + do i = 1, npix { + if (a[i] < 0) + b[i] = errfcn (a[i]) + else + { + b[i] = sqrt (real (a[i])) + } + } +end diff --git a/sys/vops/lz/asqrx.x b/sys/vops/lz/asqrx.x new file mode 100644 index 00000000..a529811c --- /dev/null +++ b/sys/vops/lz/asqrx.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASQR -- Compute the square root of a vector (generic). If the square root +# is undefined (x < 0) a user supplied function is called to compute the value. + +procedure asqrx (a, b, npix, errfcn) + +complex a[ARB], b[ARB] +int npix, i +extern errfcn() +complex errfcn() +errchk errfcn + +begin + do i = 1, npix { + { + b[i] = sqrt (a[i]) + } + } +end diff --git a/sys/vops/lz/asrtc.x b/sys/vops/lz/asrtc.x new file mode 100644 index 00000000..f4de2d71 --- /dev/null +++ b/sys/vops/lz/asrtc.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +# ASRT -- Vector Quicksort. The output vector may be the same as the +# input vector. + +procedure asrtc (a, b, npix) + +char a[ARB], b[ARB] # input, output arrays +int npix # number of pixels + +char pivot, temp +int i, j, k, p, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} + +begin + call amovc (a, b, npix) # in place sort + + 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 + } + } +end diff --git a/sys/vops/lz/asrtd.x b/sys/vops/lz/asrtd.x new file mode 100644 index 00000000..64d52880 --- /dev/null +++ b/sys/vops/lz/asrtd.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +# ASRT -- Vector Quicksort. The output vector may be the same as the +# input vector. + +procedure asrtd (a, b, npix) + +double a[ARB], b[ARB] # input, output arrays +int npix # number of pixels + +double pivot, temp +int i, j, k, p, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} + +begin + call amovd (a, b, npix) # in place sort + + 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 + } + } +end diff --git a/sys/vops/lz/asrti.x b/sys/vops/lz/asrti.x new file mode 100644 index 00000000..e956a8bd --- /dev/null +++ b/sys/vops/lz/asrti.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +# ASRT -- Vector Quicksort. The output vector may be the same as the +# input vector. + +procedure asrti (a, b, npix) + +int a[ARB], b[ARB] # input, output arrays +int npix # number of pixels + +int pivot, temp +int i, j, k, p, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} + +begin + call amovi (a, b, npix) # in place sort + + 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 + } + } +end diff --git a/sys/vops/lz/asrtl.x b/sys/vops/lz/asrtl.x new file mode 100644 index 00000000..ddc1c59b --- /dev/null +++ b/sys/vops/lz/asrtl.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +# ASRT -- Vector Quicksort. The output vector may be the same as the +# input vector. + +procedure asrtl (a, b, npix) + +long a[ARB], b[ARB] # input, output arrays +int npix # number of pixels + +long pivot, temp +int i, j, k, p, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} + +begin + call amovl (a, b, npix) # in place sort + + 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 + } + } +end diff --git a/sys/vops/lz/asrtr.x b/sys/vops/lz/asrtr.x new file mode 100644 index 00000000..a4be1ed2 --- /dev/null +++ b/sys/vops/lz/asrtr.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +# ASRT -- Vector Quicksort. The output vector may be the same as the +# input vector. + +procedure asrtr (a, b, npix) + +real a[ARB], b[ARB] # input, output arrays +int npix # number of pixels + +real pivot, temp +int i, j, k, p, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} + +begin + call amovr (a, b, npix) # in place sort + + 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 + } + } +end diff --git a/sys/vops/lz/asrts.x b/sys/vops/lz/asrts.x new file mode 100644 index 00000000..b0bff6e6 --- /dev/null +++ b/sys/vops/lz/asrts.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +# ASRT -- Vector Quicksort. The output vector may be the same as the +# input vector. + +procedure asrts (a, b, npix) + +short a[ARB], b[ARB] # input, output arrays +int npix # number of pixels + +short pivot, temp +int i, j, k, p, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} + +begin + call amovs (a, b, npix) # in place sort + + 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 + } + } +end diff --git a/sys/vops/lz/asrtx.x b/sys/vops/lz/asrtx.x new file mode 100644 index 00000000..7e0c421b --- /dev/null +++ b/sys/vops/lz/asrtx.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +# ASRT -- Vector Quicksort. The output vector may be the same as the +# input vector. + +procedure asrtx (a, b, npix) + +complex a[ARB], b[ARB] # input, output arrays +int npix # number of pixels + +complex pivot, temp +int i, j, k, p, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} + +begin + call amovx (a, b, npix) # in place sort + + 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; abs(b[i]) < abs(pivot); i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (abs(b[j]) <= abs(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 + } + } +end diff --git a/sys/vops/lz/assqd.x b/sys/vops/lz/assqd.x new file mode 100644 index 00000000..ec8d4190 --- /dev/null +++ b/sys/vops/lz/assqd.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASSQ -- Vector sum of squares. + +double procedure assqd (a, npix) +double sum + +double a[ARB] +int npix +int i + +begin + sum = 0.0D0 + do i = 1, npix + sum = sum + (a[i] ** 2) + + return (sum) +end diff --git a/sys/vops/lz/assqi.x b/sys/vops/lz/assqi.x new file mode 100644 index 00000000..73091f16 --- /dev/null +++ b/sys/vops/lz/assqi.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASSQ -- Vector sum of squares. + +real procedure assqi (a, npix) +real sum + +int a[ARB] +int npix +int i + +begin + sum = 0 + do i = 1, npix + sum = sum + (a[i] ** 2) + + return (sum) +end diff --git a/sys/vops/lz/assql.x b/sys/vops/lz/assql.x new file mode 100644 index 00000000..096f9a76 --- /dev/null +++ b/sys/vops/lz/assql.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASSQ -- Vector sum of squares. + +double procedure assql (a, npix) +double sum + +long a[ARB] +int npix +int i + +begin + sum = 0 + do i = 1, npix + sum = sum + (a[i] ** 2) + + return (sum) +end diff --git a/sys/vops/lz/assqr.x b/sys/vops/lz/assqr.x new file mode 100644 index 00000000..ffb83e57 --- /dev/null +++ b/sys/vops/lz/assqr.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASSQ -- Vector sum of squares. + +real procedure assqr (a, npix) +real sum + +real a[ARB] +int npix +int i + +begin + sum = 0.0 + do i = 1, npix + sum = sum + (a[i] ** 2) + + return (sum) +end diff --git a/sys/vops/lz/assqs.x b/sys/vops/lz/assqs.x new file mode 100644 index 00000000..094f9285 --- /dev/null +++ b/sys/vops/lz/assqs.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASSQ -- Vector sum of squares. + +real procedure assqs (a, npix) +real sum + +short a[ARB] +int npix +int i + +begin + sum = 0 + do i = 1, npix + sum = sum + (a[i] ** 2) + + return (sum) +end diff --git a/sys/vops/lz/assqx.x b/sys/vops/lz/assqx.x new file mode 100644 index 00000000..adf4edb0 --- /dev/null +++ b/sys/vops/lz/assqx.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASSQ -- Vector sum of squares. + +complex procedure assqx (a, npix) +complex sum + +complex a[ARB] +int npix +int i + +begin + sum = (0.0,0.0) + do i = 1, npix + sum = sum + (a[i] ** 2) + + return (sum) +end diff --git a/sys/vops/lz/asubd.x b/sys/vops/lz/asubd.x new file mode 100644 index 00000000..faa1943a --- /dev/null +++ b/sys/vops/lz/asubd.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUB -- Subtract two vectors (generic). + +procedure asubd (a, b, c, npix) + +double a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b[i] +end diff --git a/sys/vops/lz/asubi.x b/sys/vops/lz/asubi.x new file mode 100644 index 00000000..6cecbfe9 --- /dev/null +++ b/sys/vops/lz/asubi.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUB -- Subtract two vectors (generic). + +procedure asubi (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b[i] +end diff --git a/sys/vops/lz/asubkd.x b/sys/vops/lz/asubkd.x new file mode 100644 index 00000000..9eed4999 --- /dev/null +++ b/sys/vops/lz/asubkd.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUBK -- Subtract a constant from a vector (generic). + +procedure asubkd (a, b, c, npix) + +double a[ARB] +double b +double c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b +end diff --git a/sys/vops/lz/asubki.x b/sys/vops/lz/asubki.x new file mode 100644 index 00000000..944e4af0 --- /dev/null +++ b/sys/vops/lz/asubki.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUBK -- Subtract a constant from a vector (generic). + +procedure asubki (a, b, c, npix) + +int a[ARB] +int b +int c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b +end diff --git a/sys/vops/lz/asubkl.x b/sys/vops/lz/asubkl.x new file mode 100644 index 00000000..7d6a7ce9 --- /dev/null +++ b/sys/vops/lz/asubkl.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUBK -- Subtract a constant from a vector (generic). + +procedure asubkl (a, b, c, npix) + +long a[ARB] +long b +long c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b +end diff --git a/sys/vops/lz/asubkr.x b/sys/vops/lz/asubkr.x new file mode 100644 index 00000000..c9a303ff --- /dev/null +++ b/sys/vops/lz/asubkr.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUBK -- Subtract a constant from a vector (generic). + +procedure asubkr (a, b, c, npix) + +real a[ARB] +real b +real c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b +end diff --git a/sys/vops/lz/asubks.x b/sys/vops/lz/asubks.x new file mode 100644 index 00000000..e0eb9d66 --- /dev/null +++ b/sys/vops/lz/asubks.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUBK -- Subtract a constant from a vector (generic). + +procedure asubks (a, b, c, npix) + +short a[ARB] +short b +short c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b +end diff --git a/sys/vops/lz/asubkx.x b/sys/vops/lz/asubkx.x new file mode 100644 index 00000000..4c9f5280 --- /dev/null +++ b/sys/vops/lz/asubkx.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUBK -- Subtract a constant from a vector (generic). + +procedure asubkx (a, b, c, npix) + +complex a[ARB] +complex b +complex c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b +end diff --git a/sys/vops/lz/asubl.x b/sys/vops/lz/asubl.x new file mode 100644 index 00000000..851f988b --- /dev/null +++ b/sys/vops/lz/asubl.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUB -- Subtract two vectors (generic). + +procedure asubl (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b[i] +end diff --git a/sys/vops/lz/asubr.x b/sys/vops/lz/asubr.x new file mode 100644 index 00000000..6ad54ba4 --- /dev/null +++ b/sys/vops/lz/asubr.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUB -- Subtract two vectors (generic). + +procedure asubr (a, b, c, npix) + +real a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b[i] +end diff --git a/sys/vops/lz/asubs.x b/sys/vops/lz/asubs.x new file mode 100644 index 00000000..6a2a5ddb --- /dev/null +++ b/sys/vops/lz/asubs.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUB -- Subtract two vectors (generic). + +procedure asubs (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b[i] +end diff --git a/sys/vops/lz/asubx.x b/sys/vops/lz/asubx.x new file mode 100644 index 00000000..7694aa7c --- /dev/null +++ b/sys/vops/lz/asubx.x @@ -0,0 +1,13 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUB -- Subtract two vectors (generic). + +procedure asubx (a, b, c, npix) + +complex a[ARB], b[ARB], c[ARB] +int npix, i + +begin + do i = 1, npix + c[i] = a[i] - b[i] +end diff --git a/sys/vops/lz/asumd.x b/sys/vops/lz/asumd.x new file mode 100644 index 00000000..24e4e7a9 --- /dev/null +++ b/sys/vops/lz/asumd.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUM -- Vector sum. Take care to prevent integer overflow by returning +# a floating point sum. + +double procedure asumd (a, npix) + +double a[ARB] +int npix +int i + +double sum + +begin + sum = 0.0D0 + do i = 1, npix + sum = sum + a[i] + + return (sum) +end diff --git a/sys/vops/lz/asumi.x b/sys/vops/lz/asumi.x new file mode 100644 index 00000000..314b100f --- /dev/null +++ b/sys/vops/lz/asumi.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUM -- Vector sum. Take care to prevent integer overflow by returning +# a floating point sum. + +real procedure asumi (a, npix) + +int a[ARB] +int npix +int i + +real sum + +begin + sum = 0 + do i = 1, npix + sum = sum + a[i] + + return (sum) +end diff --git a/sys/vops/lz/asuml.x b/sys/vops/lz/asuml.x new file mode 100644 index 00000000..4a2f9ec1 --- /dev/null +++ b/sys/vops/lz/asuml.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUM -- Vector sum. Take care to prevent integer overflow by returning +# a floating point sum. + +double procedure asuml (a, npix) + +long a[ARB] +int npix +int i + +double sum + +begin + sum = 0 + do i = 1, npix + sum = sum + a[i] + + return (sum) +end diff --git a/sys/vops/lz/asumr.x b/sys/vops/lz/asumr.x new file mode 100644 index 00000000..962be9cc --- /dev/null +++ b/sys/vops/lz/asumr.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUM -- Vector sum. Take care to prevent integer overflow by returning +# a floating point sum. + +real procedure asumr (a, npix) + +real a[ARB] +int npix +int i + +real sum + +begin + sum = 0.0 + do i = 1, npix + sum = sum + a[i] + + return (sum) +end diff --git a/sys/vops/lz/asums.x b/sys/vops/lz/asums.x new file mode 100644 index 00000000..663dab08 --- /dev/null +++ b/sys/vops/lz/asums.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUM -- Vector sum. Take care to prevent integer overflow by returning +# a floating point sum. + +real procedure asums (a, npix) + +short a[ARB] +int npix +int i + +real sum + +begin + sum = 0 + do i = 1, npix + sum = sum + a[i] + + return (sum) +end diff --git a/sys/vops/lz/asumx.x b/sys/vops/lz/asumx.x new file mode 100644 index 00000000..936cdaf3 --- /dev/null +++ b/sys/vops/lz/asumx.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# ASUM -- Vector sum. Take care to prevent integer overflow by returning +# a floating point sum. + +complex procedure asumx (a, npix) + +complex a[ARB] +int npix +int i + +complex sum + +begin + sum = (0.0,0.0) + do i = 1, npix + sum = sum + a[i] + + return (sum) +end diff --git a/sys/vops/lz/aupxd.x b/sys/vops/lz/aupxd.x new file mode 100644 index 00000000..38e9fa53 --- /dev/null +++ b/sys/vops/lz/aupxd.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AUPX -- Unpack the real and imaginary components of a complex vector into +# two output vectors of some other type. + +procedure aupxd (a, b, c, npix) + +complex a[ARB] # input vector +double b[ARB], c[ARB] # output vectors +int npix +int i + +begin + do i = 1, npix { + b[i] = real (a[i]) + c[i] = aimag (a[i]) + } +end diff --git a/sys/vops/lz/aupxi.x b/sys/vops/lz/aupxi.x new file mode 100644 index 00000000..59e76ced --- /dev/null +++ b/sys/vops/lz/aupxi.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AUPX -- Unpack the real and imaginary components of a complex vector into +# two output vectors of some other type. + +procedure aupxi (a, b, c, npix) + +complex a[ARB] # input vector +int b[ARB], c[ARB] # output vectors +int npix +int i + +begin + do i = 1, npix { + b[i] = real (a[i]) + c[i] = aimag (a[i]) + } +end diff --git a/sys/vops/lz/aupxl.x b/sys/vops/lz/aupxl.x new file mode 100644 index 00000000..96147678 --- /dev/null +++ b/sys/vops/lz/aupxl.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AUPX -- Unpack the real and imaginary components of a complex vector into +# two output vectors of some other type. + +procedure aupxl (a, b, c, npix) + +complex a[ARB] # input vector +long b[ARB], c[ARB] # output vectors +int npix +int i + +begin + do i = 1, npix { + b[i] = real (a[i]) + c[i] = aimag (a[i]) + } +end diff --git a/sys/vops/lz/aupxr.x b/sys/vops/lz/aupxr.x new file mode 100644 index 00000000..135683fe --- /dev/null +++ b/sys/vops/lz/aupxr.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AUPX -- Unpack the real and imaginary components of a complex vector into +# two output vectors of some other type. + +procedure aupxr (a, b, c, npix) + +complex a[ARB] # input vector +real b[ARB], c[ARB] # output vectors +int npix +int i + +begin + do i = 1, npix { + b[i] = real (a[i]) + c[i] = aimag (a[i]) + } +end diff --git a/sys/vops/lz/aupxs.x b/sys/vops/lz/aupxs.x new file mode 100644 index 00000000..82996096 --- /dev/null +++ b/sys/vops/lz/aupxs.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AUPX -- Unpack the real and imaginary components of a complex vector into +# two output vectors of some other type. + +procedure aupxs (a, b, c, npix) + +complex a[ARB] # input vector +short b[ARB], c[ARB] # output vectors +int npix +int i + +begin + do i = 1, npix { + b[i] = real (a[i]) + c[i] = aimag (a[i]) + } +end diff --git a/sys/vops/lz/aupxx.x b/sys/vops/lz/aupxx.x new file mode 100644 index 00000000..109bdc01 --- /dev/null +++ b/sys/vops/lz/aupxx.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AUPX -- Unpack the real and imaginary components of a complex vector into +# two output vectors of some other type. + +procedure aupxx (a, b, c, npix) + +complex a[ARB] # input vector +complex b[ARB], c[ARB] # output vectors +int npix +int i + +begin + do i = 1, npix { + b[i] = complex (real(a[i]), 0.0) + c[i] = complex (0.0, aimag(a[i])) + } +end diff --git a/sys/vops/lz/aveqc.x b/sys/vops/lz/aveqc.x new file mode 100644 index 00000000..e8d07db1 --- /dev/null +++ b/sys/vops/lz/aveqc.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AVEQ -- Compare two vectors for equality. + +bool procedure aveqc (a, b, npix) + +char a[ARB], b[ARB] #I vectors to be compared +int npix #I number of pixels to be compared + +int i + +begin + do i = 1, npix + if (a[i] != b[i]) + return (false) + + return (true) +end diff --git a/sys/vops/lz/aveqd.x b/sys/vops/lz/aveqd.x new file mode 100644 index 00000000..d67daeb8 --- /dev/null +++ b/sys/vops/lz/aveqd.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AVEQ -- Compare two vectors for equality. + +bool procedure aveqd (a, b, npix) + +double a[ARB], b[ARB] #I vectors to be compared +int npix #I number of pixels to be compared + +int i + +begin + do i = 1, npix + if (a[i] != b[i]) + return (false) + + return (true) +end diff --git a/sys/vops/lz/aveqi.x b/sys/vops/lz/aveqi.x new file mode 100644 index 00000000..913224b4 --- /dev/null +++ b/sys/vops/lz/aveqi.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AVEQ -- Compare two vectors for equality. + +bool procedure aveqi (a, b, npix) + +int a[ARB], b[ARB] #I vectors to be compared +int npix #I number of pixels to be compared + +int i + +begin + do i = 1, npix + if (a[i] != b[i]) + return (false) + + return (true) +end diff --git a/sys/vops/lz/aveql.x b/sys/vops/lz/aveql.x new file mode 100644 index 00000000..ce05898e --- /dev/null +++ b/sys/vops/lz/aveql.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AVEQ -- Compare two vectors for equality. + +bool procedure aveql (a, b, npix) + +long a[ARB], b[ARB] #I vectors to be compared +int npix #I number of pixels to be compared + +int i + +begin + do i = 1, npix + if (a[i] != b[i]) + return (false) + + return (true) +end diff --git a/sys/vops/lz/aveqr.x b/sys/vops/lz/aveqr.x new file mode 100644 index 00000000..01faffe2 --- /dev/null +++ b/sys/vops/lz/aveqr.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AVEQ -- Compare two vectors for equality. + +bool procedure aveqr (a, b, npix) + +real a[ARB], b[ARB] #I vectors to be compared +int npix #I number of pixels to be compared + +int i + +begin + do i = 1, npix + if (a[i] != b[i]) + return (false) + + return (true) +end diff --git a/sys/vops/lz/aveqs.x b/sys/vops/lz/aveqs.x new file mode 100644 index 00000000..92680633 --- /dev/null +++ b/sys/vops/lz/aveqs.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AVEQ -- Compare two vectors for equality. + +bool procedure aveqs (a, b, npix) + +short a[ARB], b[ARB] #I vectors to be compared +int npix #I number of pixels to be compared + +int i + +begin + do i = 1, npix + if (a[i] != b[i]) + return (false) + + return (true) +end diff --git a/sys/vops/lz/aveqx.x b/sys/vops/lz/aveqx.x new file mode 100644 index 00000000..2d616b1a --- /dev/null +++ b/sys/vops/lz/aveqx.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AVEQ -- Compare two vectors for equality. + +bool procedure aveqx (a, b, npix) + +complex a[ARB], b[ARB] #I vectors to be compared +int npix #I number of pixels to be compared + +int i + +begin + do i = 1, npix + if (a[i] != b[i]) + return (false) + + return (true) +end diff --git a/sys/vops/lz/awsud.x b/sys/vops/lz/awsud.x new file mode 100644 index 00000000..f2e5e02e --- /dev/null +++ b/sys/vops/lz/awsud.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWSU -- Vector weighted sum. C = A * k1 + B * k2 + +procedure awsud (a, b, c, npix, k1, k2) + +double a[ARB], b[ARB], c[ARB] +double k1, k2 +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * k1 + b[i] * k2 +end diff --git a/sys/vops/lz/awsui.x b/sys/vops/lz/awsui.x new file mode 100644 index 00000000..0e75feed --- /dev/null +++ b/sys/vops/lz/awsui.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWSU -- Vector weighted sum. C = A * k1 + B * k2 + +procedure awsui (a, b, c, npix, k1, k2) + +int a[ARB], b[ARB], c[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * k1 + b[i] * k2 +end diff --git a/sys/vops/lz/awsul.x b/sys/vops/lz/awsul.x new file mode 100644 index 00000000..1a8dd058 --- /dev/null +++ b/sys/vops/lz/awsul.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWSU -- Vector weighted sum. C = A * k1 + B * k2 + +procedure awsul (a, b, c, npix, k1, k2) + +long a[ARB], b[ARB], c[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * k1 + b[i] * k2 +end diff --git a/sys/vops/lz/awsur.x b/sys/vops/lz/awsur.x new file mode 100644 index 00000000..4efd8909 --- /dev/null +++ b/sys/vops/lz/awsur.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWSU -- Vector weighted sum. C = A * k1 + B * k2 + +procedure awsur (a, b, c, npix, k1, k2) + +real a[ARB], b[ARB], c[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * k1 + b[i] * k2 +end diff --git a/sys/vops/lz/awsus.x b/sys/vops/lz/awsus.x new file mode 100644 index 00000000..78ee5bbf --- /dev/null +++ b/sys/vops/lz/awsus.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWSU -- Vector weighted sum. C = A * k1 + B * k2 + +procedure awsus (a, b, c, npix, k1, k2) + +short a[ARB], b[ARB], c[ARB] +real k1, k2 +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * k1 + b[i] * k2 +end diff --git a/sys/vops/lz/awsux.x b/sys/vops/lz/awsux.x new file mode 100644 index 00000000..7516bd8b --- /dev/null +++ b/sys/vops/lz/awsux.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWSU -- Vector weighted sum. C = A * k1 + B * k2 + +procedure awsux (a, b, c, npix, k1, k2) + +complex a[ARB], b[ARB], c[ARB] +complex k1, k2 +int npix, i + +begin + do i = 1, npix + c[i] = a[i] * k1 + b[i] * k2 +end diff --git a/sys/vops/lz/awvgd.x b/sys/vops/lz/awvgd.x new file mode 100644 index 00000000..58b1d87b --- /dev/null +++ b/sys/vops/lz/awvgd.x @@ -0,0 +1,62 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWVG -- Compute the mean and standard deviation (sigma) of a sample. Pixels +# whose value lies outside the specified lower and upper limits are not used. +# If the upper and lower limits have the same value (e.g., zero), no limit +# checking is performed. The number of pixels in the sample is returned as the +# function value. + +int procedure awvgd (a, npix, mean, sigma, lcut, hcut) + +double a[ARB] +double mean, sigma, lcut, hcut +double sum, sumsq, value, temp +int npix, i, ngpix + +begin + sum = 0.0 + sumsq = 0.0 + ngpix = 0 + + # Accumulate sum, sum of squares. The test to disable limit checking + # requires numerical equality of two floating point numbers; this should + # be ok since they are used as flags not as numbers (they are not used + # in computations). + + if (hcut == lcut) { + do i = 1, npix { + value = a[i] + sum = sum + value + sumsq = sumsq + value ** 2 + } + ngpix = npix + + } else { + do i = 1, npix { + value = a[i] + if (value >= lcut && value <= hcut) { + ngpix = ngpix + 1 + sum = sum + value + sumsq = sumsq + value ** 2 + } + } + } + + switch (ngpix) { # compute mean and sigma + case 0: + mean = INDEFD + sigma = INDEFD + case 1: + mean = sum + sigma = INDEFD + default: + mean = sum / ngpix + temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngpix) +end diff --git a/sys/vops/lz/awvgi.x b/sys/vops/lz/awvgi.x new file mode 100644 index 00000000..b1e78ebe --- /dev/null +++ b/sys/vops/lz/awvgi.x @@ -0,0 +1,62 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWVG -- Compute the mean and standard deviation (sigma) of a sample. Pixels +# whose value lies outside the specified lower and upper limits are not used. +# If the upper and lower limits have the same value (e.g., zero), no limit +# checking is performed. The number of pixels in the sample is returned as the +# function value. + +int procedure awvgi (a, npix, mean, sigma, lcut, hcut) + +int a[ARB] +real mean, sigma, lcut, hcut +double sum, sumsq, value, temp +int npix, i, ngpix + +begin + sum = 0.0 + sumsq = 0.0 + ngpix = 0 + + # Accumulate sum, sum of squares. The test to disable limit checking + # requires numerical equality of two floating point numbers; this should + # be ok since they are used as flags not as numbers (they are not used + # in computations). + + if (hcut == lcut) { + do i = 1, npix { + value = a[i] + sum = sum + value + sumsq = sumsq + value ** 2 + } + ngpix = npix + + } else { + do i = 1, npix { + value = a[i] + if (value >= lcut && value <= hcut) { + ngpix = ngpix + 1 + sum = sum + value + sumsq = sumsq + value ** 2 + } + } + } + + switch (ngpix) { # compute mean and sigma + case 0: + mean = INDEFR + sigma = INDEFR + case 1: + mean = sum + sigma = INDEFR + default: + mean = sum / ngpix + temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngpix) +end diff --git a/sys/vops/lz/awvgl.x b/sys/vops/lz/awvgl.x new file mode 100644 index 00000000..d56d0a8a --- /dev/null +++ b/sys/vops/lz/awvgl.x @@ -0,0 +1,62 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWVG -- Compute the mean and standard deviation (sigma) of a sample. Pixels +# whose value lies outside the specified lower and upper limits are not used. +# If the upper and lower limits have the same value (e.g., zero), no limit +# checking is performed. The number of pixels in the sample is returned as the +# function value. + +int procedure awvgl (a, npix, mean, sigma, lcut, hcut) + +long a[ARB] +double mean, sigma, lcut, hcut +double sum, sumsq, value, temp +int npix, i, ngpix + +begin + sum = 0.0 + sumsq = 0.0 + ngpix = 0 + + # Accumulate sum, sum of squares. The test to disable limit checking + # requires numerical equality of two floating point numbers; this should + # be ok since they are used as flags not as numbers (they are not used + # in computations). + + if (hcut == lcut) { + do i = 1, npix { + value = a[i] + sum = sum + value + sumsq = sumsq + value ** 2 + } + ngpix = npix + + } else { + do i = 1, npix { + value = a[i] + if (value >= lcut && value <= hcut) { + ngpix = ngpix + 1 + sum = sum + value + sumsq = sumsq + value ** 2 + } + } + } + + switch (ngpix) { # compute mean and sigma + case 0: + mean = INDEFD + sigma = INDEFD + case 1: + mean = sum + sigma = INDEFD + default: + mean = sum / ngpix + temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngpix) +end diff --git a/sys/vops/lz/awvgr.x b/sys/vops/lz/awvgr.x new file mode 100644 index 00000000..fab5efe7 --- /dev/null +++ b/sys/vops/lz/awvgr.x @@ -0,0 +1,62 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWVG -- Compute the mean and standard deviation (sigma) of a sample. Pixels +# whose value lies outside the specified lower and upper limits are not used. +# If the upper and lower limits have the same value (e.g., zero), no limit +# checking is performed. The number of pixels in the sample is returned as the +# function value. + +int procedure awvgr (a, npix, mean, sigma, lcut, hcut) + +real a[ARB] +real mean, sigma, lcut, hcut +double sum, sumsq, value, temp +int npix, i, ngpix + +begin + sum = 0.0 + sumsq = 0.0 + ngpix = 0 + + # Accumulate sum, sum of squares. The test to disable limit checking + # requires numerical equality of two floating point numbers; this should + # be ok since they are used as flags not as numbers (they are not used + # in computations). + + if (hcut == lcut) { + do i = 1, npix { + value = a[i] + sum = sum + value + sumsq = sumsq + value ** 2 + } + ngpix = npix + + } else { + do i = 1, npix { + value = a[i] + if (value >= lcut && value <= hcut) { + ngpix = ngpix + 1 + sum = sum + value + sumsq = sumsq + value ** 2 + } + } + } + + switch (ngpix) { # compute mean and sigma + case 0: + mean = INDEFR + sigma = INDEFR + case 1: + mean = sum + sigma = INDEFR + default: + mean = sum / ngpix + temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngpix) +end diff --git a/sys/vops/lz/awvgs.x b/sys/vops/lz/awvgs.x new file mode 100644 index 00000000..8237be56 --- /dev/null +++ b/sys/vops/lz/awvgs.x @@ -0,0 +1,62 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWVG -- Compute the mean and standard deviation (sigma) of a sample. Pixels +# whose value lies outside the specified lower and upper limits are not used. +# If the upper and lower limits have the same value (e.g., zero), no limit +# checking is performed. The number of pixels in the sample is returned as the +# function value. + +int procedure awvgs (a, npix, mean, sigma, lcut, hcut) + +short a[ARB] +real mean, sigma, lcut, hcut +double sum, sumsq, value, temp +int npix, i, ngpix + +begin + sum = 0.0 + sumsq = 0.0 + ngpix = 0 + + # Accumulate sum, sum of squares. The test to disable limit checking + # requires numerical equality of two floating point numbers; this should + # be ok since they are used as flags not as numbers (they are not used + # in computations). + + if (hcut == lcut) { + do i = 1, npix { + value = a[i] + sum = sum + value + sumsq = sumsq + value ** 2 + } + ngpix = npix + + } else { + do i = 1, npix { + value = a[i] + if (value >= lcut && value <= hcut) { + ngpix = ngpix + 1 + sum = sum + value + sumsq = sumsq + value ** 2 + } + } + } + + switch (ngpix) { # compute mean and sigma + case 0: + mean = INDEFR + sigma = INDEFR + case 1: + mean = sum + sigma = INDEFR + default: + mean = sum / ngpix + temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngpix) +end diff --git a/sys/vops/lz/awvgx.x b/sys/vops/lz/awvgx.x new file mode 100644 index 00000000..82fe4192 --- /dev/null +++ b/sys/vops/lz/awvgx.x @@ -0,0 +1,62 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AWVG -- Compute the mean and standard deviation (sigma) of a sample. Pixels +# whose value lies outside the specified lower and upper limits are not used. +# If the upper and lower limits have the same value (e.g., zero), no limit +# checking is performed. The number of pixels in the sample is returned as the +# function value. + +int procedure awvgx (a, npix, mean, sigma, lcut, hcut) + +complex a[ARB] +real mean, sigma, lcut, hcut +double sum, sumsq, value, temp +int npix, i, ngpix + +begin + sum = 0.0 + sumsq = 0.0 + ngpix = 0 + + # Accumulate sum, sum of squares. The test to disable limit checking + # requires numerical equality of two floating point numbers; this should + # be ok since they are used as flags not as numbers (they are not used + # in computations). + + if (hcut == lcut) { + do i = 1, npix { + value = abs (a[i]) + sum = sum + value + sumsq = sumsq + value ** 2 + } + ngpix = npix + + } else { + do i = 1, npix { + value = abs (a[i]) + if (value >= lcut && value <= hcut) { + ngpix = ngpix + 1 + sum = sum + value + sumsq = sumsq + value ** 2 + } + } + } + + switch (ngpix) { # compute mean and sigma + case 0: + mean = INDEFR + sigma = INDEFR + case 1: + mean = sum + sigma = INDEFR + default: + mean = sum / ngpix + temp = (sumsq - (sum/ngpix) * sum) / (ngpix - 1) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngpix) +end diff --git a/sys/vops/lz/axori.x b/sys/vops/lz/axori.x new file mode 100644 index 00000000..e6df0010 --- /dev/null +++ b/sys/vops/lz/axori.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AXOR -- Compute the exclusive or of two vectors (generic). + +procedure axori (a, b, c, npix) + +int a[ARB], b[ARB], c[ARB] +int npix, i +int xor() + +begin + do i = 1, npix { + c[i] = xor (a[i], b[i]) + } +end diff --git a/sys/vops/lz/axorki.x b/sys/vops/lz/axorki.x new file mode 100644 index 00000000..5e08a769 --- /dev/null +++ b/sys/vops/lz/axorki.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AXORK -- Compute the boolean or of a vector and a constant (generic). + +procedure axorki (a, b, c, npix) + +int a[ARB] +int b +int c[ARB] +int npix, i +int xor() + +begin + do i = 1, npix { + c[i] = xor (a[i], b) + } +end diff --git a/sys/vops/lz/axorkl.x b/sys/vops/lz/axorkl.x new file mode 100644 index 00000000..df4f074f --- /dev/null +++ b/sys/vops/lz/axorkl.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AXORK -- Compute the boolean or of a vector and a constant (generic). + +procedure axorkl (a, b, c, npix) + +long a[ARB] +long b +long c[ARB] +int npix, i +long xorl() + +begin + do i = 1, npix { + c[i] = xorl (a[i], b) + } +end diff --git a/sys/vops/lz/axorks.x b/sys/vops/lz/axorks.x new file mode 100644 index 00000000..d85e283d --- /dev/null +++ b/sys/vops/lz/axorks.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AXORK -- Compute the boolean or of a vector and a constant (generic). + +procedure axorks (a, b, c, npix) + +short a[ARB] +short b +short c[ARB] +int npix, i +short xors() + +begin + do i = 1, npix { + c[i] = xors (a[i], b) + } +end diff --git a/sys/vops/lz/axorl.x b/sys/vops/lz/axorl.x new file mode 100644 index 00000000..d4087fd3 --- /dev/null +++ b/sys/vops/lz/axorl.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AXOR -- Compute the exclusive or of two vectors (generic). + +procedure axorl (a, b, c, npix) + +long a[ARB], b[ARB], c[ARB] +int npix, i +long xorl() + +begin + do i = 1, npix { + c[i] = xorl (a[i], b[i]) + } +end diff --git a/sys/vops/lz/axors.x b/sys/vops/lz/axors.x new file mode 100644 index 00000000..ab3c073d --- /dev/null +++ b/sys/vops/lz/axors.x @@ -0,0 +1,15 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# AXOR -- Compute the exclusive or of two vectors (generic). + +procedure axors (a, b, c, npix) + +short a[ARB], b[ARB], c[ARB] +int npix, i +short xors() + +begin + do i = 1, npix { + c[i] = xors (a[i], b[i]) + } +end diff --git a/sys/vops/lz/mkpkg b/sys/vops/lz/mkpkg new file mode 100644 index 00000000..046aa2b7 --- /dev/null +++ b/sys/vops/lz/mkpkg @@ -0,0 +1,330 @@ +# Make the VOPS vector operators library, procedures a[l-z]*.*. + +$checkout libvops.a lib$ +$update libvops.a +$checkin libvops.a lib$ +$exit + +libvops.a: + alans.x + alani.x + alanl.x + alanks.x + alanki.x + alankl.x + alimc.x + alimd.x + alimi.x + aliml.x + alimr.x + alims.x + alimx.x + allnd.x + allni.x + allnl.x + allnr.x + allns.x + allnx.x + alogd.x + alogi.x + alogl.x + alogr.x + alogs.x + alogx.x + alors.x + alori.x + alorl.x + alorks.x + alorki.x + alorkl.x + alovc.x + alovd.x + alovi.x + alovl.x + alovr.x + alovs.x + alovx.x + altad.x + altai.x + altal.x + altar.x + altas.x + altax.x + altmd.x + altmi.x + altml.x + altmr.x + altms.x + altmx.x + altrd.x + altri.x + altrl.x + altrr.x + altrs.x + altrx.x + aluid.x <mach.h> + aluii.x <mach.h> + aluil.x <mach.h> + aluir.x <mach.h> + aluis.x <mach.h> + alutc.x + alutd.x + aluti.x + alutl.x + alutr.x + aluts.x + amagd.x + amagi.x + amagl.x + amagr.x + amags.x + amagx.x + amapd.x + amapi.x + amapl.x + amapr.x + amaps.x + amaxc.x + amaxd.x + amaxi.x + amaxkc.x + amaxkd.x + amaxki.x + amaxkl.x + amaxkr.x + amaxks.x + amaxkx.x + amaxl.x + amaxr.x + amaxs.x + amaxx.x + amed3c.x + amed3d.x + amed3i.x + amed3l.x + amed3r.x + amed3s.x + amed4c.x + amed4d.x + amed4i.x + amed4l.x + amed4r.x + amed4s.x + amed5c.x + amed5d.x + amed5i.x + amed5l.x + amed5r.x + amed5s.x + amedc.x + amedd.x + amedi.x + amedl.x + amedr.x + ameds.x + amedx.x + amgsd.x + amgsi.x + amgsl.x + amgsr.x + amgss.x + amgsx.x + aminc.x + amind.x + amini.x + aminkc.x + aminkd.x + aminki.x + aminkl.x + aminkr.x + aminks.x + aminkx.x + aminl.x + aminr.x + amins.x + aminx.x + amodd.x + amodi.x + amodkd.x + amodki.x + amodkl.x + amodkr.x + amodks.x + amodl.x + amodr.x + amods.x + amovc.x + amovd.x + amovi.x + amovkc.x + amovkd.x + amovki.x + amovkl.x + amovkr.x + amovks.x + amovkx.x + amovl.x + amovr.x + amovs.x + amovx.x + amuld.x + amuli.x + amulkd.x + amulki.x + amulkl.x + amulkr.x + amulks.x + amulkx.x + amull.x + amulr.x + amuls.x + amulx.x + anegd.x + anegi.x + anegl.x + anegr.x + anegs.x + anegx.x + anoti.x + anotl.x + anots.x + apkxd.x + apkxi.x + apkxl.x + apkxr.x + apkxs.x + apkxx.x + apold.x + apolr.x + apowd.x + apowi.x + apowkd.x + apowki.x + apowkl.x + apowkr.x + apowks.x + apowkx.x + apowl.x + apowr.x + apows.x + apowx.x + aravd.x <mach.h> + aravi.x <mach.h> + aravl.x <mach.h> + aravr.x <mach.h> + aravs.x <mach.h> + aravx.x <mach.h> + arcpd.x + arcpi.x + arcpl.x + arcpr.x + arcps.x + arcpx.x + arczd.x + arczi.x + arczl.x + arczr.x + arczs.x + arczx.x + argtd.x + argti.x + argtl.x + argtr.x + argts.x + argtx.x + arltd.x + arlti.x + arltl.x + arltr.x + arlts.x + arltx.x + aselc.x + aseld.x + aseli.x + asell.x + aselr.x + asels.x + aselx.x + aselkc.x + aselkd.x + aselki.x + aselkl.x + aselkr.x + aselks.x + aselkx.x + asokc.x <mach.h> + asokd.x <mach.h> + asoki.x <mach.h> + asokl.x <mach.h> + asokr.x <mach.h> + asoks.x <mach.h> + asokx.x <mach.h> + asqrd.x + asqri.x + asqrl.x + asqrr.x + asqrs.x + asqrx.x + asrtc.x + asrtd.x + asrti.x + asrtl.x + asrtr.x + asrts.x + asrtx.x + assqd.x + assqi.x + assql.x + assqr.x + assqs.x + assqx.x + asubd.x + asubi.x + asubkd.x + asubki.x + asubkl.x + asubkr.x + asubks.x + asubkx.x + asubl.x + asubr.x + asubs.x + asubx.x + asumd.x + asumi.x + asuml.x + asumr.x + asums.x + asumx.x + aupxd.x + aupxi.x + aupxl.x + aupxr.x + aupxs.x + aupxx.x + aveqc.x + aveqd.x + aveqi.x + aveql.x + aveqr.x + aveqs.x + aveqx.x + awsud.x + awsui.x + awsul.x + awsur.x + awsus.x + awsux.x + awvgd.x + awvgi.x + awvgl.x + awvgr.x + awvgs.x + awvgx.x + axori.x + axorki.x + axorkl.x + axorks.x + axorl.x + axors.x + ; |