From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- pkg/utilities/nttools/tjoin/readtol.x | 55 +++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 pkg/utilities/nttools/tjoin/readtol.x (limited to 'pkg/utilities/nttools/tjoin/readtol.x') diff --git a/pkg/utilities/nttools/tjoin/readtol.x b/pkg/utilities/nttools/tjoin/readtol.x new file mode 100644 index 00000000..4b35f522 --- /dev/null +++ b/pkg/utilities/nttools/tjoin/readtol.x @@ -0,0 +1,55 @@ +include "tjoin.h" +define SZ_VALUE 30 + +# B.Simon 16-Apr-99 first code + +# READ_TOL -- Parse the string containing the vector of tolerance values + +pointer procedure read_tol (tolerance) + +char tolerance[ARB] # i: Comma separated string of tolerance values +#-- +int ic, jc, nc, ival +pointer sp, value, errtxt, tol + +string badvalue "Invalid value in tolerance (%s)" +string negvalue "Negative value in tolerance (%g)" + +bool is_number() +int word_count(), word_fetch(), ctod() + +begin + call smark (sp) + call salloc (value, SZ_VALUE, TY_CHAR) + call salloc (errtxt, SZ_LINE, TY_CHAR) + + call malloc (tol, LEN_TOLSTRUCT, TY_INT) + + TOL_NUM(tol) = word_count (tolerance) + call malloc (TOL_PTR(tol), TOL_NUM(tol), TY_DOUBLE) + + ic = 1 + ival = 1 + while (word_fetch (tolerance, ic, Memc[value], SZ_VALUE) > 0) { + if (! is_number (Memc[value])) { + call sprintf (Memc[errtxt], SZ_LINE, badvalue) + call pargstr (Memc[value]) + call error (1, Memc[errtxt]) + } + + jc = 1 + nc = ctod (Memc[value], jc, TOL_VAL(tol,ival)) + + if (TOL_VAL(tol,ival) < 0.0) { + call sprintf (Memc[errtxt], SZ_LINE, negvalue) + call pargd (TOL_VAL(tol,ival)) + call error (1, Memc[errtxt]) + } + + ival = ival + 1 + } + + call sfree (sp) + return (tol) +end + -- cgit