diff options
Diffstat (limited to 'pkg/utilities/nttools/trebin/trebin.x')
| -rw-r--r-- | pkg/utilities/nttools/trebin/trebin.x | 136 |
1 files changed, 136 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/trebin/trebin.x b/pkg/utilities/nttools/trebin/trebin.x new file mode 100644 index 00000000..873f3b05 --- /dev/null +++ b/pkg/utilities/nttools/trebin/trebin.x @@ -0,0 +1,136 @@ +include <error.h> +include <tbset.h> +include "trebin.h" + +# trebin -- resample to uniform spacing +# This task resamples a table or list of tables to uniformly spaced +# values of the independent variable. +# +# Phil Hodge, 14-Apr-1988 Task created. +# Phil Hodge, 30-Jan-1992 Delete inlist, outlist. +# Phil Hodge, 16-Jun-1993 Set the sign of 'step' based on 'start' and 'end'. +# Phil Hodge, 4-Oct-1995 Modify to use tbn instead of fnt. +# Phil Hodge, 21-May-1996 Include extrapolate and ext_value. +# Phil Hodge, 22-Apr-1999 Get 'step' even if 'start' and 'end' are the same. +# Phil Hodge, 25-Apr-2000 Get inlist, outlist, xlist in this routine +# instead of in tnam_init; also get padvalue. +# Phil Hodge, 4-Nov-2000 It is an error if step = 0, unless start = end + +procedure trebin() + +pointer sp +pointer inlist # scratch for list of input table names +pointer outlist # scratch for list of output table names +pointer xlist # scratch for list of table names for X +pointer intable # scratch for name of input table +pointer outtable # scratch for name of output table +pointer outdir # scratch for name of output directory +pointer xtable # scratch for name of indep var table +double iv_start # starting value of independent variable +double iv_end # ending value of independent variable +double iv_step # increment in independent variable +bool extrapolate # true means extrapolate if out of bounds +double ext_value # value to use when out of bounds +double padvalue # value at end of input indep. var. to ignore +char iv_col[SZ_COLNAME] # name of independent variable column +char func[SZ_FNAME] # interpolation function +int i_func # interpolation function +pointer in_t, xin_t, out_t # fn template pointers for input & output lists +bool verbose # print file names? +double clgetd() +bool clgetb() +int tnam_gio() + +begin + # Get input and output table template lists. + call smark (sp) + call salloc (inlist, SZ_LINE, TY_CHAR) + call salloc (outlist, SZ_LINE, TY_CHAR) + call salloc (xlist, SZ_LINE, TY_CHAR) + call salloc (intable, SZ_FNAME, TY_CHAR) + call salloc (outtable, SZ_FNAME, TY_CHAR) + call salloc (xtable, SZ_FNAME, TY_CHAR) + call salloc (outdir, SZ_FNAME, TY_CHAR) + + call clgstr ("intable", Memc[inlist], SZ_LINE) + call clgstr ("outtable", Memc[outlist], SZ_LINE) + call clgstr ("column", iv_col, SZ_COLNAME) + call clgstr ("xtable", Memc[xlist], SZ_LINE) + + # Open the input & output lists of table names. + call tnam_init (Memc[inlist], Memc[xlist], Memc[outlist], + in_t, xin_t, out_t, Memc[outdir], SZ_FNAME) + + if (xin_t == NULL) { + + # Get parameters for linearly spaced output independent variable. + iv_start = clgetd ("start") + iv_end = clgetd ("end") + iv_step = clgetd ("step") + if (iv_step == 0.d0 && iv_start != iv_end) + call error (1, "step = 0 is invalid") + + # Set the sign of 'step', rather than expecting the user + # to set it correctly. + if (iv_start < iv_end) + iv_step = abs (iv_step) + else if (iv_start > iv_end) + iv_step = -abs (iv_step) + + } else { + + iv_start = 0.d0 + iv_end = 0.d0 + iv_step = 0.d0 + } + + call clgstr ("function", func, SZ_FNAME) + extrapolate = clgetb ("extrapolate") + if (extrapolate) + ext_value = INDEFD # not used + else + ext_value = clgetd ("value") + + padvalue = clgetd ("padvalue") + + verbose = clgetb ("verbose") + + call tuiset (func, i_func) # set interpolator type + + # Process each table. + while (tnam_gio (in_t, xin_t, out_t, Memc[outdir], + Memc[intable], Memc[xtable], Memc[outtable], SZ_FNAME) != EOF) { + + if (verbose) { + if (Memc[xtable] != EOS) { + call printf ("%s, %s --> %s\n") + call pargstr (Memc[intable]) + call pargstr (Memc[xtable]) + call pargstr (Memc[outtable]) + } else { + call printf ("%s --> %s\n") + call pargstr (Memc[intable]) + call pargstr (Memc[outtable]) + } + call flush (STDOUT) + } + + iferr { + call tuinterp (Memc[intable], Memc[xtable], Memc[outtable], + i_func, iv_col, iv_start, iv_end, iv_step, + extrapolate, ext_value, padvalue, verbose) + } then { + call erract (EA_WARN) + if (verbose) { + call eprintf ("This table will be skipped.\n") + } else { + call eprintf ("Table %s will be skipped.\n") + call pargstr (Memc[intable]) + } + next + } + } + + call tnam_cls (in_t, xin_t, out_t) + call sfree (sp) +end |