octave-nkf: liboctave/cruft/odepack/slsode.f annotate

annotate liboctave/cruft/odepack/slsode.f @ 19627:446c46af4b42 stable

strip trailing whitespace from most source files * Makefile.am, NEWS, build-aux/common.mk, configure.ac, doc/Makefile.am, doc/doxyhtml/Makefile.am, doc/interpreter/Makefile.am, doc/interpreter/arith.txi, doc/interpreter/audio.txi, doc/interpreter/basics.txi, doc/interpreter/bugs.txi, doc/interpreter/container.txi, doc/interpreter/cp-idx.txi, doc/interpreter/data.txi, doc/interpreter/debug.txi, doc/interpreter/diagperm.txi, doc/interpreter/diffeq.txi, doc/interpreter/doccheck/README, doc/interpreter/doccheck/spellcheck, doc/interpreter/emacs.txi, doc/interpreter/errors.txi, doc/interpreter/eval.txi, doc/interpreter/expr.txi, doc/interpreter/external.txi, doc/interpreter/fn-idx.txi, doc/interpreter/func.txi, doc/interpreter/geometry.txi, doc/interpreter/geometryimages.m, doc/interpreter/gpl.txi, doc/interpreter/grammar.txi, doc/interpreter/gui.txi, doc/interpreter/image.txi, doc/interpreter/install.txi, doc/interpreter/interp.txi, doc/interpreter/interpimages.m, doc/interpreter/intro.txi, doc/interpreter/io.txi, doc/interpreter/java.txi, doc/interpreter/linalg.txi, doc/interpreter/macros.texi, doc/interpreter/matrix.txi, doc/interpreter/munge-texi.pl, doc/interpreter/nonlin.txi, doc/interpreter/numbers.txi, doc/interpreter/obsolete.txi, doc/interpreter/octave-config.1, doc/interpreter/octave.texi, doc/interpreter/oop.txi, doc/interpreter/op-idx.txi, doc/interpreter/optim.txi, doc/interpreter/package.txi, doc/interpreter/plot.txi, doc/interpreter/poly.txi, doc/interpreter/preface.txi, doc/interpreter/quad.txi, doc/interpreter/set.txi, doc/interpreter/signal.txi, doc/interpreter/sparse.txi, doc/interpreter/sparseimages.m, doc/interpreter/splineimages.m, doc/interpreter/stats.txi, doc/interpreter/stmt.txi, doc/interpreter/strings.txi, doc/interpreter/system.txi, doc/interpreter/testfun.txi, doc/interpreter/tips.txi, doc/interpreter/var.txi, doc/interpreter/vectorize.txi, doc/liboctave/Makefile.am, doc/liboctave/array.texi, doc/liboctave/bugs.texi, doc/liboctave/cp-idx.texi, doc/liboctave/dae.texi, doc/liboctave/diffeq.texi, doc/liboctave/error.texi, doc/liboctave/factor.texi, doc/liboctave/fn-idx.texi, doc/liboctave/gpl.texi, doc/liboctave/install.texi, doc/liboctave/intro.texi, doc/liboctave/liboctave.texi, doc/liboctave/matvec.texi, doc/liboctave/nleqn.texi, doc/liboctave/nlfunc.texi, doc/liboctave/ode.texi, doc/liboctave/optim.texi, doc/liboctave/preface.texi, doc/liboctave/quad.texi, doc/liboctave/range.texi, doc/refcard/Makefile.am, doc/refcard/refcard.tex, etc/HACKING, etc/NEWS.1, etc/NEWS.2, etc/NEWS.3, etc/OLD-ChangeLogs/ChangeLog, etc/OLD-ChangeLogs/doc-ChangeLog, etc/OLD-ChangeLogs/scripts-ChangeLog, etc/OLD-ChangeLogs/src-ChangeLog, etc/OLD-ChangeLogs/test-ChangeLog, etc/PROJECTS, etc/README.Cygwin, etc/README.MacOS, etc/README.MinGW, etc/README.gnuplot, etc/gdbinit, etc/icons/Makefile.am, examples/@polynomial/end.m, examples/@polynomial/subsasgn.m, examples/Makefile.am, examples/standalonebuiltin.cc, libgui/Makefile.am, libgui/qterminal/libqterminal/README, libgui/qterminal/libqterminal/unix/BlockArray.cpp, libgui/qterminal/libqterminal/unix/BlockArray.h, libgui/qterminal/libqterminal/unix/Character.h, libgui/qterminal/libqterminal/unix/CharacterColor.h, libgui/qterminal/libqterminal/unix/Emulation.cpp, libgui/qterminal/libqterminal/unix/Emulation.h, libgui/qterminal/libqterminal/unix/Filter.cpp, libgui/qterminal/libqterminal/unix/Filter.h, libgui/qterminal/libqterminal/unix/History.cpp, libgui/qterminal/libqterminal/unix/History.h, libgui/qterminal/libqterminal/unix/KeyboardTranslator.cpp, libgui/qterminal/libqterminal/unix/KeyboardTranslator.h, libgui/qterminal/libqterminal/unix/LineFont.h, libgui/qterminal/libqterminal/unix/QUnixTerminalImpl.cpp, libgui/qterminal/libqterminal/unix/QUnixTerminalImpl.h, libgui/qterminal/libqterminal/unix/Screen.cpp, libgui/qterminal/libqterminal/unix/Screen.h, libgui/qterminal/libqterminal/unix/ScreenWindow.cpp, libgui/qterminal/libqterminal/unix/ScreenWindow.h, libgui/qterminal/libqterminal/unix/TerminalCharacterDecoder.cpp, libgui/qterminal/libqterminal/unix/TerminalCharacterDecoder.h, libgui/qterminal/libqterminal/unix/Vt102Emulation.h, libgui/qterminal/libqterminal/win32/QWinTerminalImpl.cpp, libgui/qterminal/qterminal/main.cpp, libgui/src/m-editor/file-editor-tab.cc, libgui/src/octave-gui.cc, libgui/src/octave-qt-link.cc, libinterp/corefcn/data.cc, libinterp/corefcn/defun-int.h, libinterp/corefcn/det.cc, libinterp/corefcn/gl2ps-renderer.cc, libinterp/corefcn/graphics.cc, libinterp/corefcn/graphics.in.h, libinterp/corefcn/ls-mat5.cc, libinterp/corefcn/lu.cc, libinterp/corefcn/oct-tex-parser.yy, libinterp/corefcn/oct-tex-symbols.in, libinterp/corefcn/quadcc.cc, libinterp/corefcn/zfstream.cc, libinterp/dldfcn/__eigs__.cc, libinterp/dldfcn/__voronoi__.cc, libinterp/gendoc.pl, libinterp/genprops.awk, libinterp/mk-errno-list, libinterp/mk-pkg-add, libinterp/mkbuiltins, libinterp/mkdefs, libinterp/mkdocs, libinterp/mkops, libinterp/octave-value/ov-java.cc, libinterp/parse-tree/lex.ll, libinterp/parse-tree/oct-parse.in.yy, libinterp/parse-tree/octave.gperf, liboctave/Makefile.am, liboctave/array/Array.cc, liboctave/array/module.mk, liboctave/cruft/daspk/datv.f, liboctave/cruft/daspk/dcnst0.f, liboctave/cruft/daspk/dcnstr.f, liboctave/cruft/daspk/ddasic.f, liboctave/cruft/daspk/ddasid.f, liboctave/cruft/daspk/ddasik.f, liboctave/cruft/daspk/ddaspk.f, liboctave/cruft/daspk/ddstp.f, liboctave/cruft/daspk/ddwnrm.f, liboctave/cruft/daspk/dfnrmd.f, liboctave/cruft/daspk/dfnrmk.f, liboctave/cruft/daspk/dhels.f, liboctave/cruft/daspk/dheqr.f, liboctave/cruft/daspk/dinvwt.f, liboctave/cruft/daspk/dlinsd.f, liboctave/cruft/daspk/dlinsk.f, liboctave/cruft/daspk/dmatd.f, liboctave/cruft/daspk/dnedd.f, liboctave/cruft/daspk/dnedk.f, liboctave/cruft/daspk/dnsd.f, liboctave/cruft/daspk/dnsid.f, liboctave/cruft/daspk/dnsik.f, liboctave/cruft/daspk/dnsk.f, liboctave/cruft/daspk/dorth.f, liboctave/cruft/daspk/dslvd.f, liboctave/cruft/daspk/dslvk.f, liboctave/cruft/daspk/dspigm.f, liboctave/cruft/daspk/dyypnw.f, liboctave/cruft/dasrt/ddasrt.f, liboctave/cruft/dasrt/drchek.f, liboctave/cruft/dassl/ddaslv.f, liboctave/cruft/dassl/ddassl.f, liboctave/cruft/misc/blaswrap.c, liboctave/cruft/misc/module.mk, liboctave/cruft/odepack/cfode.f, liboctave/cruft/odepack/dlsode.f, liboctave/cruft/odepack/ewset.f, liboctave/cruft/odepack/intdy.f, liboctave/cruft/odepack/prepj.f, liboctave/cruft/odepack/sintdy.f, liboctave/cruft/odepack/slsode.f, liboctave/cruft/odepack/solsy.f, liboctave/cruft/odepack/ssolsy.f, liboctave/cruft/odepack/stode.f, liboctave/cruft/odepack/vnorm.f, liboctave/cruft/ranlib/Basegen.doc, liboctave/cruft/ranlib/README, liboctave/cruft/ranlib/genbet.f, liboctave/cruft/ranlib/genexp.f, liboctave/cruft/ranlib/gennch.f, liboctave/cruft/ranlib/gennf.f, liboctave/cruft/ranlib/gennor.f, liboctave/cruft/ranlib/getsd.f, liboctave/cruft/ranlib/initgn.f, liboctave/cruft/ranlib/phrtsd.f, liboctave/cruft/ranlib/randlib.fdoc, liboctave/cruft/ranlib/setsd.f, liboctave/cruft/ranlib/tstgmn.for, liboctave/cruft/ranlib/tstmid.for, liboctave/cruft/slatec-fn/atanh.f, liboctave/cruft/slatec-fn/datanh.f, liboctave/cruft/slatec-fn/xgmainc.f, liboctave/cruft/slatec-fn/xsgmainc.f, liboctave/numeric/module.mk, liboctave/operators/mk-ops.awk, liboctave/operators/mx-ops, liboctave/operators/sparse-mk-ops.awk, liboctave/operators/sparse-mx-ops, liboctave/operators/vx-ops, liboctave/util/module.mk, run-octave.in, scripts/@ftp/ftp.m, scripts/audio/wavread.m, scripts/deprecated/java_convert_matrix.m, scripts/deprecated/java_debug.m, scripts/deprecated/java_invoke.m, scripts/deprecated/java_new.m, scripts/deprecated/java_unsigned_conversion.m, scripts/deprecated/javafields.m, scripts/deprecated/javamethods.m, scripts/deprecated/shell_cmd.m, scripts/general/accumarray.m, scripts/general/display.m, scripts/general/fieldnames.m, scripts/general/interp1.m, scripts/general/interp2.m, scripts/general/interp3.m, scripts/general/isa.m, scripts/general/methods.m, scripts/general/sortrows.m, scripts/geometry/convhull.m, scripts/geometry/delaunay.m, scripts/geometry/delaunay3.m, scripts/geometry/delaunayn.m, scripts/geometry/griddata.m, scripts/geometry/griddatan.m, scripts/geometry/voronoi.m, scripts/geometry/voronoin.m, scripts/gui/guihandles.m, scripts/gui/inputdlg.m, scripts/gui/listdlg.m, scripts/gui/msgbox.m, scripts/gui/questdlg.m, scripts/gui/uigetfile.m, scripts/gui/waitbar.m, scripts/gui/warndlg.m, scripts/help/doc.m, scripts/help/help.m, scripts/help/type.m, scripts/image/bone.m, scripts/image/cmpermute.m, scripts/image/cmunique.m, scripts/image/colorcube.m, scripts/image/colormap.m, scripts/image/contrast.m, scripts/image/gray2ind.m, scripts/image/image.m, scripts/image/imshow.m, scripts/image/ind2gray.m, scripts/image/jet.m, scripts/image/rgb2ntsc.m, scripts/image/spinmap.m, scripts/io/importdata.m, scripts/io/strread.m, scripts/io/textread.m, scripts/io/textscan.m, scripts/java/java_get.m, scripts/java/java_set.m, scripts/java/javaaddpath.m, scripts/java/javaclasspath.m, scripts/java/javamem.m, scripts/linear-algebra/linsolve.m, scripts/linear-algebra/qzhess.m, scripts/miscellaneous/debug.m, scripts/miscellaneous/desktop.m, scripts/miscellaneous/dir.m, scripts/miscellaneous/dos.m, scripts/miscellaneous/edit.m, scripts/miscellaneous/fact.m, scripts/miscellaneous/getappdata.m, scripts/miscellaneous/inputname.m, scripts/miscellaneous/license.m, scripts/miscellaneous/ls_command.m, scripts/miscellaneous/run.m, scripts/miscellaneous/setfield.m, scripts/miscellaneous/unix.m, scripts/miscellaneous/ver.m, scripts/mk-pkg-add, scripts/mkdoc.pl, scripts/optimization/fminsearch.m, scripts/optimization/optimset.m, scripts/optimization/sqp.m, scripts/pkg/pkg.m, scripts/pkg/private/create_pkgadddel.m, scripts/pkg/private/fix_depends.m, scripts/pkg/private/install.m, scripts/plot/appearance/axis.m, scripts/plot/appearance/box.m, scripts/plot/appearance/clabel.m, scripts/plot/appearance/daspect.m, scripts/plot/appearance/datetick.m, scripts/plot/appearance/grid.m, scripts/plot/appearance/legend.m, scripts/plot/appearance/orient.m, scripts/plot/appearance/shading.m, scripts/plot/appearance/text.m, scripts/plot/appearance/title.m, scripts/plot/appearance/xlabel.m, scripts/plot/appearance/ylabel.m, scripts/plot/appearance/zlabel.m, scripts/plot/draw/area.m, scripts/plot/draw/bar.m, scripts/plot/draw/barh.m, scripts/plot/draw/colorbar.m, scripts/plot/draw/contour.m, scripts/plot/draw/contour3.m, scripts/plot/draw/contourf.m, scripts/plot/draw/ellipsoid.m, scripts/plot/draw/errorbar.m, scripts/plot/draw/ezcontour.m, scripts/plot/draw/ezcontourf.m, scripts/plot/draw/ezmesh.m, scripts/plot/draw/ezpolar.m, scripts/plot/draw/fill.m, scripts/plot/draw/fplot.m, scripts/plot/draw/hist.m, scripts/plot/draw/meshc.m, scripts/plot/draw/meshz.m, scripts/plot/draw/pareto.m, scripts/plot/draw/patch.m, scripts/plot/draw/peaks.m, scripts/plot/draw/pie.m, scripts/plot/draw/pie3.m, scripts/plot/draw/plot.m, scripts/plot/draw/plotyy.m, scripts/plot/draw/private/__bar__.m, scripts/plot/draw/private/__contour__.m, scripts/plot/draw/private/__errplot__.m, scripts/plot/draw/private/__ezplot__.m, scripts/plot/draw/private/__patch__.m, scripts/plot/draw/private/__stem__.m, scripts/plot/draw/rectangle.m, scripts/plot/draw/ribbon.m, scripts/plot/draw/rose.m, scripts/plot/draw/scatter.m, scripts/plot/draw/scatter3.m, scripts/plot/draw/semilogx.m, scripts/plot/draw/shrinkfaces.m, scripts/plot/draw/sombrero.m, scripts/plot/draw/sphere.m, scripts/plot/draw/stairs.m, scripts/plot/draw/stem.m, scripts/plot/draw/stemleaf.m, scripts/plot/draw/surf.m, scripts/plot/draw/surface.m, scripts/plot/draw/surfc.m, scripts/plot/draw/surfl.m, scripts/plot/draw/surfnorm.m, scripts/plot/draw/tetramesh.m, scripts/plot/draw/trimesh.m, scripts/plot/draw/triplot.m, scripts/plot/draw/trisurf.m, scripts/plot/util/__gnuplot_drawnow__.m, scripts/plot/util/__plt_get_axis_arg__.m, scripts/plot/util/axes.m, scripts/plot/util/clf.m, scripts/plot/util/copyobj.m, scripts/plot/util/figure.m, scripts/plot/util/gcbo.m, scripts/plot/util/graphics_toolkit.m, scripts/plot/util/hggroup.m, scripts/plot/util/meshgrid.m, scripts/plot/util/newplot.m, scripts/plot/util/print.m, scripts/plot/util/private/__add_default_menu__.m, scripts/plot/util/private/__fltk_print__.m, scripts/plot/util/private/__gnuplot_print__.m, scripts/plot/util/private/__print_parse_opts__.m, scripts/plot/util/refreshdata.m, scripts/plot/util/subplot.m, scripts/polynomial/conv.m, scripts/polynomial/poly.m, scripts/polynomial/polyeig.m, scripts/polynomial/polyfit.m, scripts/polynomial/polyval.m, scripts/polynomial/private/__splinefit__.m, scripts/polynomial/spline.m, scripts/prefs/prefdir.m, scripts/prefs/preferences.m, scripts/prefs/private/prefsfile.m, scripts/prefs/rmpref.m, scripts/signal/freqz.m, scripts/signal/module.mk, scripts/sparse/eigs.m, scripts/sparse/pcg.m, scripts/sparse/private/__sprand_impl__.m, scripts/sparse/sprand.m, scripts/sparse/sprandn.m, scripts/sparse/spy.m, scripts/sparse/svds.m, scripts/specfun/expint.m, scripts/specfun/factor.m, scripts/special-matrix/gallery.m, scripts/special-matrix/hankel.m, scripts/special-matrix/toeplitz.m, scripts/startup/inputrc, scripts/statistics/base/kurtosis.m, scripts/statistics/base/moment.m, scripts/statistics/base/qqplot.m, scripts/statistics/base/var.m, scripts/statistics/distributions/betarnd.m, scripts/statistics/distributions/binoinv.m, scripts/statistics/distributions/binopdf.m, scripts/statistics/distributions/binornd.m, scripts/statistics/distributions/cauchy_rnd.m, scripts/statistics/distributions/chi2rnd.m, scripts/statistics/distributions/discrete_pdf.m, scripts/statistics/distributions/discrete_rnd.m, scripts/statistics/distributions/empirical_rnd.m, scripts/statistics/distributions/exprnd.m, scripts/statistics/distributions/frnd.m, scripts/statistics/distributions/gamrnd.m, scripts/statistics/distributions/geornd.m, scripts/statistics/distributions/hygernd.m, scripts/statistics/distributions/kolmogorov_smirnov_cdf.m, scripts/statistics/distributions/laplace_cdf.m, scripts/statistics/distributions/laplace_pdf.m, scripts/statistics/distributions/logistic_cdf.m, scripts/statistics/distributions/logistic_pdf.m, scripts/statistics/distributions/lognrnd.m, scripts/statistics/distributions/nbincdf.m, scripts/statistics/distributions/nbininv.m, scripts/statistics/distributions/nbinpdf.m, scripts/statistics/distributions/nbinrnd.m, scripts/statistics/distributions/normrnd.m, scripts/statistics/distributions/poissinv.m, scripts/statistics/distributions/poissrnd.m, scripts/statistics/distributions/tinv.m, scripts/statistics/distributions/trnd.m, scripts/statistics/distributions/unidcdf.m, scripts/statistics/distributions/unidpdf.m, scripts/statistics/distributions/unidrnd.m, scripts/statistics/distributions/unifrnd.m, scripts/statistics/distributions/wblrnd.m, scripts/statistics/models/module.mk, scripts/statistics/tests/kruskal_wallis_test.m, scripts/strings/base2dec.m, scripts/strings/deblank.m, scripts/strings/dec2base.m, scripts/strings/dec2bin.m, scripts/strings/dec2hex.m, scripts/strings/mat2str.m, scripts/strings/ostrsplit.m, scripts/strings/regexptranslate.m, scripts/strings/str2num.m, scripts/strings/strcat.m, scripts/strings/strjoin.m, scripts/strings/strsplit.m, scripts/strings/strtok.m, scripts/strings/strtrim.m, scripts/strings/strtrunc.m, scripts/strings/substr.m, scripts/testfun/__run_test_suite__.m, scripts/testfun/speed.m, scripts/testfun/test.m, scripts/time/asctime.m, scripts/time/datenum.m, scripts/time/datevec.m, scripts/time/weekday.m, src/Makefile.am, test/Makefile.am, test/build-bc-overload-tests.sh, test/build-sparse-tests.sh, test/jit.tst, test/line-continue.tst: Strip trailing whitespace.

author	John W. Eaton <jwe@octave.org>
date	Tue, 20 Jan 2015 08:26:57 -0500
parents	648dabbb4c6b
children

rev	line source
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1 *DECK SLSODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	2 SUBROUTINE SLSODE (F, NEQ, Y, T, TOUT, ITOL, RTOL, ATOL, ITASK,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	3 1 ISTATE, IOPT, RWORK, LRW, IWORK, LIW, JAC, MF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	4 EXTERNAL F, JAC
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	5 INTEGER NEQ, ITOL, ITASK, ISTATE, IOPT, LRW, IWORK, LIW, MF
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	6 REAL Y, T, TOUT, RTOL, ATOL, RWORK
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	7 DIMENSION NEQ(), Y(), RTOL(), ATOL(), RWORK(LRW), IWORK(LIW)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	8 C***BEGIN PROLOGUE SLSODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	9 C***PURPOSE Livermore Solver for Ordinary Differential Equations.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	10 C SLSODE solves the initial-value problem for stiff or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	11 C nonstiff systems of first-order ODE's,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	12 C dy/dt = f(t,y), or, in component form,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	13 C dy(i)/dt = f(i) = f(i,t,y(1),y(2),...,y(N)), i=1,...,N.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	14 C***CATEGORY I1A
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	15 C***TYPE SINGLE PRECISION (SLSODE-S, DLSODE-D)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	16 C***KEYWORDS ORDINARY DIFFERENTIAL EQUATIONS, INITIAL VALUE PROBLEM,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	17 C STIFF, NONSTIFF
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	18 C***AUTHOR Hindmarsh, Alan C., (LLNL)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	19 C Center for Applied Scientific Computing, L-561
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	20 C Lawrence Livermore National Laboratory
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	21 C Livermore, CA 94551.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	22 C***DESCRIPTION
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	23 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	24 C NOTE: The "Usage" and "Arguments" sections treat only a subset of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	25 C available options, in condensed fashion. The options
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	26 C covered and the information supplied will support most
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	27 C standard uses of SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	28 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	29 C For more sophisticated uses, full details on all options are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	30 C given in the concluding section, headed "Long Description."
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	31 C A synopsis of the SLSODE Long Description is provided at the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	32 C beginning of that section; general topics covered are:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	33 C - Elements of the call sequence; optional input and output
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	34 C - Optional supplemental routines in the SLSODE package
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	35 C - internal COMMON block
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	36 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	37 C *Usage:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	38 C Communication between the user and the SLSODE package, for normal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	39 C situations, is summarized here. This summary describes a subset
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	40 C of the available options. See "Long Description" for complete
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	41 C details, including optional communication, nonstandard options,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	42 C and instructions for special situations.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	43 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	44 C A sample program is given in the "Examples" section.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	45 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	46 C Refer to the argument descriptions for the definitions of the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	47 C quantities that appear in the following sample declarations.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	48 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	49 C For MF = 10,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	50 C PARAMETER (LRW = 20 + 16*NEQ, LIW = 20)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	51 C For MF = 21 or 22,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	52 C PARAMETER (LRW = 22 + 9NEQ + NEQ*2, LIW = 20 + NEQ)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	53 C For MF = 24 or 25,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	54 C PARAMETER (LRW = 22 + 10NEQ + (2ML+MU)*NEQ,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	55 C * LIW = 20 + NEQ)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	56 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	57 C EXTERNAL F, JAC
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	58 C INTEGER NEQ, ITOL, ITASK, ISTATE, IOPT, LRW, IWORK(LIW),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	59 C * LIW, MF
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	60 C REAL Y(NEQ), T, TOUT, RTOL, ATOL(ntol), RWORK(LRW)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	61 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	62 C CALL SLSODE (F, NEQ, Y, T, TOUT, ITOL, RTOL, ATOL, ITASK,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	63 C * ISTATE, IOPT, RWORK, LRW, IWORK, LIW, JAC, MF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	64 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	65 C *Arguments:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	66 C F :EXT Name of subroutine for right-hand-side vector f.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	67 C This name must be declared EXTERNAL in calling
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	68 C program. The form of F must be:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	69 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	70 C SUBROUTINE F (NEQ, T, Y, YDOT)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	71 C INTEGER NEQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	72 C REAL T, Y(), YDOT()
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	73 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	74 C The inputs are NEQ, T, Y. F is to set
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	75 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	76 C YDOT(i) = f(i,T,Y(1),Y(2),...,Y(NEQ)),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	77 C i = 1, ..., NEQ .
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	78 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	79 C NEQ :IN Number of first-order ODE's.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	80 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	81 C Y :INOUT Array of values of the y(t) vector, of length NEQ.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	82 C Input: For the first call, Y should contain the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	83 C values of y(t) at t = T. (Y is an input
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	84 C variable only if ISTATE = 1.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	85 C Output: On return, Y will contain the values at the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	86 C new t-value.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	87 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	88 C T :INOUT Value of the independent variable. On return it
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	89 C will be the current value of t (normally TOUT).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	90 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	91 C TOUT :IN Next point where output is desired (.NE. T).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	92 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	93 C ITOL :IN 1 or 2 according as ATOL (below) is a scalar or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	94 C an array.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	95 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	96 C RTOL :IN Relative tolerance parameter (scalar).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	97 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	98 C ATOL :IN Absolute tolerance parameter (scalar or array).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	99 C If ITOL = 1, ATOL need not be dimensioned.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	100 C If ITOL = 2, ATOL must be dimensioned at least NEQ.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	101 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	102 C The estimated local error in Y(i) will be controlled
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	103 C so as to be roughly less (in magnitude) than
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	104 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	105 C EWT(i) = RTOL*ABS(Y(i)) + ATOL if ITOL = 1, or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	106 C EWT(i) = RTOL*ABS(Y(i)) + ATOL(i) if ITOL = 2.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	107 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	108 C Thus the local error test passes if, in each
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	109 C component, either the absolute error is less than
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	110 C ATOL (or ATOL(i)), or the relative error is less
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	111 C than RTOL.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	112 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	113 C Use RTOL = 0.0 for pure absolute error control, and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	114 C use ATOL = 0.0 (or ATOL(i) = 0.0) for pure relative
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	115 C error control. Caution: Actual (global) errors may
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	116 C exceed these local tolerances, so choose them
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	117 C conservatively.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	118 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	119 C ITASK :IN Flag indicating the task SLSODE is to perform.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	120 C Use ITASK = 1 for normal computation of output
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	121 C values of y at t = TOUT.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	122 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	123 C ISTATE:INOUT Index used for input and output to specify the state
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	124 C of the calculation.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	125 C Input:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	126 C 1 This is the first call for a problem.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	127 C 2 This is a subsequent call.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	128 C Output:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	129 C 1 Nothing was done, as TOUT was equal to T.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	130 C 2 SLSODE was successful (otherwise, negative).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	131 C Note that ISTATE need not be modified after a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	132 C successful return.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	133 C -1 Excess work done on this call (perhaps wrong
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	134 C MF).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	135 C -2 Excess accuracy requested (tolerances too
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	136 C small).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	137 C -3 Illegal input detected (see printed message).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	138 C -4 Repeated error test failures (check all
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	139 C inputs).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	140 C -5 Repeated convergence failures (perhaps bad
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	141 C Jacobian supplied or wrong choice of MF or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	142 C tolerances).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	143 C -6 Error weight became zero during problem
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	144 C (solution component i vanished, and ATOL or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	145 C ATOL(i) = 0.).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	146 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	147 C IOPT :IN Flag indicating whether optional inputs are used:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	148 C 0 No.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	149 C 1 Yes. (See "Optional inputs" under "Long
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	150 C Description," Part 1.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	151 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	152 C RWORK :WORK Real work array of length at least:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	153 C 20 + 16*NEQ for MF = 10,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	154 C 22 + 9NEQ + NEQ*2 for MF = 21 or 22,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	155 C 22 + 10NEQ + (2ML + MU)*NEQ for MF = 24 or 25.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	156 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	157 C LRW :IN Declared length of RWORK (in user's DIMENSION
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	158 C statement).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	159 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	160 C IWORK :WORK Integer work array of length at least:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	161 C 20 for MF = 10,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	162 C 20 + NEQ for MF = 21, 22, 24, or 25.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	163 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	164 C If MF = 24 or 25, input in IWORK(1),IWORK(2) the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	165 C lower and upper Jacobian half-bandwidths ML,MU.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	166 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	167 C On return, IWORK contains information that may be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	168 C of interest to the user:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	169 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	170 C Name Location Meaning
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	171 C ----- --------- -----------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	172 C NST IWORK(11) Number of steps taken for the problem so
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	173 C far.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	174 C NFE IWORK(12) Number of f evaluations for the problem
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	175 C so far.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	176 C NJE IWORK(13) Number of Jacobian evaluations (and of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	177 C matrix LU decompositions) for the problem
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	178 C so far.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	179 C NQU IWORK(14) Method order last used (successfully).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	180 C LENRW IWORK(17) Length of RWORK actually required. This
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	181 C is defined on normal returns and on an
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	182 C illegal input return for insufficient
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	183 C storage.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	184 C LENIW IWORK(18) Length of IWORK actually required. This
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	185 C is defined on normal returns and on an
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	186 C illegal input return for insufficient
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	187 C storage.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	188 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	189 C LIW :IN Declared length of IWORK (in user's DIMENSION
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	190 C statement).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	191 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	192 C JAC :EXT Name of subroutine for Jacobian matrix (MF =
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	193 C 21 or 24). If used, this name must be declared
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	194 C EXTERNAL in calling program. If not used, pass a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	195 C dummy name. The form of JAC must be:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	196 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	197 C SUBROUTINE JAC (NEQ, T, Y, ML, MU, PD, NROWPD)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	198 C INTEGER NEQ, ML, MU, NROWPD
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	199 C REAL T, Y(), PD(NROWPD,)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	200 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	201 C See item c, under "Description" below for more
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	202 C information about JAC.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	203 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	204 C MF :IN Method flag. Standard values are:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	205 C 10 Nonstiff (Adams) method, no Jacobian used.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	206 C 21 Stiff (BDF) method, user-supplied full Jacobian.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	207 C 22 Stiff method, internally generated full
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	208 C Jacobian.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	209 C 24 Stiff method, user-supplied banded Jacobian.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	210 C 25 Stiff method, internally generated banded
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	211 C Jacobian.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	212 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	213 C *Description:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	214 C SLSODE solves the initial value problem for stiff or nonstiff
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	215 C systems of first-order ODE's,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	216 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	217 C dy/dt = f(t,y) ,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	218 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	219 C or, in component form,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	220 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	221 C dy(i)/dt = f(i) = f(i,t,y(1),y(2),...,y(NEQ))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	222 C (i = 1, ..., NEQ) .
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	223 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	224 C SLSODE is a package based on the GEAR and GEARB packages, and on
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	225 C the October 23, 1978, version of the tentative ODEPACK user
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	226 C interface standard, with minor modifications.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	227 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	228 C The steps in solving such a problem are as follows.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	229 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	230 C a. First write a subroutine of the form
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	231 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	232 C SUBROUTINE F (NEQ, T, Y, YDOT)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	233 C INTEGER NEQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	234 C REAL T, Y(), YDOT()
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	235 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	236 C which supplies the vector function f by loading YDOT(i) with
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	237 C f(i).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	238 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	239 C b. Next determine (or guess) whether or not the problem is stiff.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	240 C Stiffness occurs when the Jacobian matrix df/dy has an
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	241 C eigenvalue whose real part is negative and large in magnitude
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	242 C compared to the reciprocal of the t span of interest. If the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	243 C problem is nonstiff, use method flag MF = 10. If it is stiff,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	244 C there are four standard choices for MF, and SLSODE requires the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	245 C Jacobian matrix in some form. This matrix is regarded either
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	246 C as full (MF = 21 or 22), or banded (MF = 24 or 25). In the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	247 C banded case, SLSODE requires two half-bandwidth parameters ML
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	248 C and MU. These are, respectively, the widths of the lower and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	249 C upper parts of the band, excluding the main diagonal. Thus the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	250 C band consists of the locations (i,j) with
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	251 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	252 C i - ML <= j <= i + MU ,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	253 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	254 C and the full bandwidth is ML + MU + 1 .
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	255 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	256 C c. If the problem is stiff, you are encouraged to supply the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	257 C Jacobian directly (MF = 21 or 24), but if this is not feasible,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	258 C SLSODE will compute it internally by difference quotients (MF =
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	259 C 22 or 25). If you are supplying the Jacobian, write a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	260 C subroutine of the form
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	261 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	262 C SUBROUTINE JAC (NEQ, T, Y, ML, MU, PD, NROWPD)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	263 C INTEGER NEQ, ML, MU, NRWOPD
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	264 C REAL T, Y(), PD(NROWPD,)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	265 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	266 C which provides df/dy by loading PD as follows:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	267 C - For a full Jacobian (MF = 21), load PD(i,j) with df(i)/dy(j),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	268 C the partial derivative of f(i) with respect to y(j). (Ignore
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	269 C the ML and MU arguments in this case.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	270 C - For a banded Jacobian (MF = 24), load PD(i-j+MU+1,j) with
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	271 C df(i)/dy(j); i.e., load the diagonal lines of df/dy into the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	272 C rows of PD from the top down.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	273 C - In either case, only nonzero elements need be loaded.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	274 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	275 C d. Write a main program that calls subroutine SLSODE once for each
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	276 C point at which answers are desired. This should also provide
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	277 C for possible use of logical unit 6 for output of error messages
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	278 C by SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	279 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	280 C Before the first call to SLSODE, set ISTATE = 1, set Y and T to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	281 C the initial values, and set TOUT to the first output point. To
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	282 C continue the integration after a successful return, simply
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	283 C reset TOUT and call SLSODE again. No other parameters need be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	284 C reset.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	285 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	286 C *Examples:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	287 C The following is a simple example problem, with the coding needed
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	288 C for its solution by SLSODE. The problem is from chemical kinetics,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	289 C and consists of the following three rate equations:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	290 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	291 C dy1/dt = -.04y1 + 1.E4y2*y3
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	292 C dy2/dt = .04y1 - 1.E4y2y3 - 3.E7y2**2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	293 C dy3/dt = 3.E7y2*2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	294 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	295 C on the interval from t = 0.0 to t = 4.E10, with initial conditions
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	296 C y1 = 1.0, y2 = y3 = 0. The problem is stiff.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	297 C
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	298 C The following coding solves this problem with SLSODE, using
446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	299 C MF = 21 and printing results at t = .4, 4., ..., 4.E10. It uses
446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	300 C ITOL = 2 and ATOL much smaller for y2 than for y1 or y3 because y2
446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	301 C has much smaller values. At the end of the run, statistical
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	302 C quantities of interest are printed.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	303 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	304 C EXTERNAL FEX, JEX
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	305 C INTEGER IOPT, IOUT, ISTATE, ITASK, ITOL, IWORK(23), LIW, LRW,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	306 C * MF, NEQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	307 C REAL ATOL(3), RTOL, RWORK(58), T, TOUT, Y(3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	308 C NEQ = 3
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	309 C Y(1) = 1.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	310 C Y(2) = 0.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	311 C Y(3) = 0.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	312 C T = 0.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	313 C TOUT = .4
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	314 C ITOL = 2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	315 C RTOL = 1.E-4
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	316 C ATOL(1) = 1.E-6
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	317 C ATOL(2) = 1.E-10
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	318 C ATOL(3) = 1.E-6
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	319 C ITASK = 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	320 C ISTATE = 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	321 C IOPT = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	322 C LRW = 58
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	323 C LIW = 23
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	324 C MF = 21
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	325 C DO 40 IOUT = 1,12
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	326 C CALL SLSODE (FEX, NEQ, Y, T, TOUT, ITOL, RTOL, ATOL, ITASK,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	327 C * ISTATE, IOPT, RWORK, LRW, IWORK, LIW, JEX, MF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	328 C WRITE(6,20) T, Y(1), Y(2), Y(3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	329 C 20 FORMAT(' At t =',E12.4,' y =',3E14.6)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	330 C IF (ISTATE .LT. 0) GO TO 80
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	331 C 40 TOUT = TOUT*10.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	332 C WRITE(6,60) IWORK(11), IWORK(12), IWORK(13)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	333 C 60 FORMAT(/' No. steps =',i4,', No. f-s =',i4,', No. J-s =',i4)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	334 C STOP
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	335 C 80 WRITE(6,90) ISTATE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	336 C 90 FORMAT(///' Error halt.. ISTATE =',I3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	337 C STOP
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	338 C END
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	339 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	340 C SUBROUTINE FEX (NEQ, T, Y, YDOT)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	341 C INTEGER NEQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	342 C REAL T, Y(3), YDOT(3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	343 C YDOT(1) = -.04Y(1) + 1.E4Y(2)*Y(3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	344 C YDOT(3) = 3.E7Y(2)Y(2)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	345 C YDOT(2) = -YDOT(1) - YDOT(3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	346 C RETURN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	347 C END
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	348 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	349 C SUBROUTINE JEX (NEQ, T, Y, ML, MU, PD, NRPD)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	350 C INTEGER NEQ, ML, MU, NRPD
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	351 C REAL T, Y(3), PD(NRPD,3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	352 C PD(1,1) = -.04
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	353 C PD(1,2) = 1.E4*Y(3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	354 C PD(1,3) = 1.E4*Y(2)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	355 C PD(2,1) = .04
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	356 C PD(2,3) = -PD(1,3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	357 C PD(3,2) = 6.E7*Y(2)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	358 C PD(2,2) = -PD(1,2) - PD(3,2)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	359 C RETURN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	360 C END
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	361 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	362 C The output from this program (on a Cray-1 in single precision)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	363 C is as follows.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	364 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	365 C At t = 4.0000e-01 y = 9.851726e-01 3.386406e-05 1.479357e-02
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	366 C At t = 4.0000e+00 y = 9.055142e-01 2.240418e-05 9.446344e-02
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	367 C At t = 4.0000e+01 y = 7.158050e-01 9.184616e-06 2.841858e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	368 C At t = 4.0000e+02 y = 4.504846e-01 3.222434e-06 5.495122e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	369 C At t = 4.0000e+03 y = 1.831701e-01 8.940379e-07 8.168290e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	370 C At t = 4.0000e+04 y = 3.897016e-02 1.621193e-07 9.610297e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	371 C At t = 4.0000e+05 y = 4.935213e-03 1.983756e-08 9.950648e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	372 C At t = 4.0000e+06 y = 5.159269e-04 2.064759e-09 9.994841e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	373 C At t = 4.0000e+07 y = 5.306413e-05 2.122677e-10 9.999469e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	374 C At t = 4.0000e+08 y = 5.494530e-06 2.197825e-11 9.999945e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	375 C At t = 4.0000e+09 y = 5.129458e-07 2.051784e-12 9.999995e-01
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	376 C At t = 4.0000e+10 y = -7.170603e-08 -2.868241e-13 1.000000e+00
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	377 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	378 C No. steps = 330, No. f-s = 405, No. J-s = 69
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	379 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	380 C *Accuracy:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	381 C The accuracy of the solution depends on the choice of tolerances
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	382 C RTOL and ATOL. Actual (global) errors may exceed these local
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	383 C tolerances, so choose them conservatively.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	384 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	385 C *Cautions:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	386 C The work arrays should not be altered between calls to SLSODE for
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	387 C the same problem, except possibly for the conditional and optional
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	388 C inputs.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	389 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	390 C *Portability:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	391 C Since NEQ is dimensioned inside SLSODE, some compilers may object
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	392 C to a call to SLSODE with NEQ a scalar variable. In this event,
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	393 C use DIMENSION NEQ(1). Similar remarks apply to RTOL and ATOL.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	394 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	395 C Note to Cray users:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	396 C For maximum efficiency, use the CFT77 compiler. Appropriate
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	397 C compiler optimization directives have been inserted for CFT77.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	398 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	399 C *Reference:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	400 C Alan C. Hindmarsh, "ODEPACK, A Systematized Collection of ODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	401 C Solvers," in Scientific Computing, R. S. Stepleman, et al., Eds.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	402 C (North-Holland, Amsterdam, 1983), pp. 55-64.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	403 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	404 C *Long Description:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	405 C The following complete description of the user interface to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	406 C SLSODE consists of four parts:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	407 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	408 C 1. The call sequence to subroutine SLSODE, which is a driver
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	409 C routine for the solver. This includes descriptions of both
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	410 C the call sequence arguments and user-supplied routines.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	411 C Following these descriptions is a description of optional
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	412 C inputs available through the call sequence, and then a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	413 C description of optional outputs in the work arrays.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	414 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	415 C 2. Descriptions of other routines in the SLSODE package that may
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	416 C be (optionally) called by the user. These provide the ability
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	417 C to alter error message handling, save and restore the internal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	418 C COMMON, and obtain specified derivatives of the solution y(t).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	419 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	420 C 3. Descriptions of COMMON block to be declared in overlay or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	421 C similar environments, or to be saved when doing an interrupt
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	422 C of the problem and continued solution later.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	423 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	424 C 4. Description of two routines in the SLSODE package, either of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	425 C which the user may replace with his own version, if desired.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	426 C These relate to the measurement of errors.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	427 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	428 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	429 C Part 1. Call Sequence
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	430 C ----------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	431 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	432 C Arguments
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	433 C ---------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	434 C The call sequence parameters used for input only are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	435 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	436 C F, NEQ, TOUT, ITOL, RTOL, ATOL, ITASK, IOPT, LRW, LIW, JAC, MF,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	437 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	438 C and those used for both input and output are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	439 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	440 C Y, T, ISTATE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	441 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	442 C The work arrays RWORK and IWORK are also used for conditional and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	443 C optional inputs and optional outputs. (The term output here
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	444 C refers to the return from subroutine SLSODE to the user's calling
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	445 C program.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	446 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	447 C The legality of input parameters will be thoroughly checked on the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	448 C initial call for the problem, but not checked thereafter unless a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	449 C change in input parameters is flagged by ISTATE = 3 on input.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	450 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	451 C The descriptions of the call arguments are as follows.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	452 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	453 C F The name of the user-supplied subroutine defining the ODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	454 C system. The system must be put in the first-order form
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	455 C dy/dt = f(t,y), where f is a vector-valued function of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	456 C the scalar t and the vector y. Subroutine F is to compute
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	457 C the function f. It is to have the form
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	458 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	459 C SUBROUTINE F (NEQ, T, Y, YDOT)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	460 C REAL T, Y(), YDOT()
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	461 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	462 C where NEQ, T, and Y are input, and the array YDOT =
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	463 C f(T,Y) is output. Y and YDOT are arrays of length NEQ.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	464 C Subroutine F should not alter Y(1),...,Y(NEQ). F must be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	465 C declared EXTERNAL in the calling program.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	466 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	467 C Subroutine F may access user-defined quantities in
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	468 C NEQ(2),... and/or in Y(NEQ(1)+1),..., if NEQ is an array
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	469 C (dimensioned in F) and/or Y has length exceeding NEQ(1).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	470 C See the descriptions of NEQ and Y below.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	471 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	472 C If quantities computed in the F routine are needed
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	473 C externally to SLSODE, an extra call to F should be made
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	474 C for this purpose, for consistent and accurate results.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	475 C If only the derivative dy/dt is needed, use SINTDY
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	476 C instead.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	477 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	478 C NEQ The size of the ODE system (number of first-order
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	479 C ordinary differential equations). Used only for input.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	480 C NEQ may be decreased, but not increased, during the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	481 C problem. If NEQ is decreased (with ISTATE = 3 on input),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	482 C the remaining components of Y should be left undisturbed,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	483 C if these are to be accessed in F and/or JAC.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	484 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	485 C Normally, NEQ is a scalar, and it is generally referred
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	486 C to as a scalar in this user interface description.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	487 C However, NEQ may be an array, with NEQ(1) set to the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	488 C system size. (The SLSODE package accesses only NEQ(1).)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	489 C In either case, this parameter is passed as the NEQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	490 C argument in all calls to F and JAC. Hence, if it is an
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	491 C array, locations NEQ(2),... may be used to store other
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	492 C integer data and pass it to F and/or JAC. Subroutines
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	493 C F and/or JAC must include NEQ in a DIMENSION statement
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	494 C in that case.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	495 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	496 C Y A real array for the vector of dependent variables, of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	497 C length NEQ or more. Used for both input and output on
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	498 C the first call (ISTATE = 1), and only for output on
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	499 C other calls. On the first call, Y must contain the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	500 C vector of initial values. On output, Y contains the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	501 C computed solution vector, evaluated at T. If desired,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	502 C the Y array may be used for other purposes between
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	503 C calls to the solver.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	504 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	505 C This array is passed as the Y argument in all calls to F
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	506 C and JAC. Hence its length may exceed NEQ, and locations
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	507 C Y(NEQ+1),... may be used to store other real data and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	508 C pass it to F and/or JAC. (The SLSODE package accesses
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	509 C only Y(1),...,Y(NEQ).)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	510 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	511 C T The independent variable. On input, T is used only on
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	512 C the first call, as the initial point of the integration.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	513 C On output, after each call, T is the value at which a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	514 C computed solution Y is evaluated (usually the same as
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	515 C TOUT). On an error return, T is the farthest point
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	516 C reached.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	517 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	518 C TOUT The next value of T at which a computed solution is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	519 C desired. Used only for input.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	520 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	521 C When starting the problem (ISTATE = 1), TOUT may be equal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	522 C to T for one call, then should not equal T for the next
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	523 C call. For the initial T, an input value of TOUT .NE. T
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	524 C is used in order to determine the direction of the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	525 C integration (i.e., the algebraic sign of the step sizes)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	526 C and the rough scale of the problem. Integration in
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	527 C either direction (forward or backward in T) is permitted.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	528 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	529 C If ITASK = 2 or 5 (one-step modes), TOUT is ignored
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	530 C after the first call (i.e., the first call with
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	531 C TOUT .NE. T). Otherwise, TOUT is required on every call.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	532 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	533 C If ITASK = 1, 3, or 4, the values of TOUT need not be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	534 C monotone, but a value of TOUT which backs up is limited
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	535 C to the current internal T interval, whose endpoints are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	536 C TCUR - HU and TCUR. (See "Optional Outputs" below for
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	537 C TCUR and HU.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	538 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	539 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	540 C ITOL An indicator for the type of error control. See
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	541 C description below under ATOL. Used only for input.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	542 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	543 C RTOL A relative error tolerance parameter, either a scalar or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	544 C an array of length NEQ. See description below under
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	545 C ATOL. Input only.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	546 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	547 C ATOL An absolute error tolerance parameter, either a scalar or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	548 C an array of length NEQ. Input only.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	549 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	550 C The input parameters ITOL, RTOL, and ATOL determine the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	551 C error control performed by the solver. The solver will
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	552 C control the vector e = (e(i)) of estimated local errors
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	553 C in Y, according to an inequality of the form
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	554 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	555 C rms-norm of ( e(i)/EWT(i) ) <= 1,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	556 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	557 C where
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	558 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	559 C EWT(i) = RTOL(i)*ABS(Y(i)) + ATOL(i),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	560 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	561 C and the rms-norm (root-mean-square norm) here is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	562 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	563 C rms-norm(v) = SQRT(sum v(i)**2 / NEQ).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	564 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	565 C Here EWT = (EWT(i)) is a vector of weights which must
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	566 C always be positive, and the values of RTOL and ATOL
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	567 C should all be nonnegative. The following table gives the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	568 C types (scalar/array) of RTOL and ATOL, and the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	569 C corresponding form of EWT(i).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	570 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	571 C ITOL RTOL ATOL EWT(i)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	572 C ---- ------ ------ -----------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	573 C 1 scalar scalar RTOL*ABS(Y(i)) + ATOL
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	574 C 2 scalar array RTOL*ABS(Y(i)) + ATOL(i)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	575 C 3 array scalar RTOL(i)*ABS(Y(i)) + ATOL
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	576 C 4 array array RTOL(i)*ABS(Y(i)) + ATOL(i)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	577 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	578 C When either of these parameters is a scalar, it need not
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	579 C be dimensioned in the user's calling program.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	580 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	581 C If none of the above choices (with ITOL, RTOL, and ATOL
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	582 C fixed throughout the problem) is suitable, more general
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	583 C error controls can be obtained by substituting
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	584 C user-supplied routines for the setting of EWT and/or for
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	585 C the norm calculation. See Part 4 below.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	586 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	587 C If global errors are to be estimated by making a repeated
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	588 C run on the same problem with smaller tolerances, then all
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	589 C components of RTOL and ATOL (i.e., of EWT) should be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	590 C scaled down uniformly.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	591 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	592 C ITASK An index specifying the task to be performed. Input
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	593 C only. ITASK has the following values and meanings:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	594 C 1 Normal computation of output values of y(t) at
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	595 C t = TOUT (by overshooting and interpolating).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	596 C 2 Take one step only and return.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	597 C 3 Stop at the first internal mesh point at or beyond
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	598 C t = TOUT and return.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	599 C 4 Normal computation of output values of y(t) at
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	600 C t = TOUT but without overshooting t = TCRIT. TCRIT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	601 C must be input as RWORK(1). TCRIT may be equal to or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	602 C beyond TOUT, but not behind it in the direction of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	603 C integration. This option is useful if the problem
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	604 C has a singularity at or beyond t = TCRIT.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	605 C 5 Take one step, without passing TCRIT, and return.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	606 C TCRIT must be input as RWORK(1).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	607 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	608 C Note: If ITASK = 4 or 5 and the solver reaches TCRIT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	609 C (within roundoff), it will return T = TCRIT (exactly) to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	610 C indicate this (unless ITASK = 4 and TOUT comes before
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	611 C TCRIT, in which case answers at T = TOUT are returned
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	612 C first).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	613 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	614 C ISTATE An index used for input and output to specify the state
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	615 C of the calculation.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	616 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	617 C On input, the values of ISTATE are as follows:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	618 C 1 This is the first call for the problem
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	619 C (initializations will be done). See "Note" below.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	620 C 2 This is not the first call, and the calculation is to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	621 C continue normally, with no change in any input
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	622 C parameters except possibly TOUT and ITASK. (If ITOL,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	623 C RTOL, and/or ATOL are changed between calls with
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	624 C ISTATE = 2, the new values will be used but not
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	625 C tested for legality.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	626 C 3 This is not the first call, and the calculation is to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	627 C continue normally, but with a change in input
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	628 C parameters other than TOUT and ITASK. Changes are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	629 C allowed in NEQ, ITOL, RTOL, ATOL, IOPT, LRW, LIW, MF,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	630 C ML, MU, and any of the optional inputs except H0.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	631 C (See IWORK description for ML and MU.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	632 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	633 C Note: A preliminary call with TOUT = T is not counted as
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	634 C a first call here, as no initialization or checking of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	635 C input is done. (Such a call is sometimes useful for the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	636 C purpose of outputting the initial conditions.) Thus the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	637 C first call for which TOUT .NE. T requires ISTATE = 1 on
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	638 C input.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	639 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	640 C On output, ISTATE has the following values and meanings:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	641 C 1 Nothing was done, as TOUT was equal to T with
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	642 C ISTATE = 1 on input.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	643 C 2 The integration was performed successfully.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	644 C -1 An excessive amount of work (more than MXSTEP steps)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	645 C was done on this call, before completing the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	646 C requested task, but the integration was otherwise
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	647 C successful as far as T. (MXSTEP is an optional input
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	648 C and is normally 500.) To continue, the user may
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	649 C simply reset ISTATE to a value >1 and call again (the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	650 C excess work step counter will be reset to 0). In
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	651 C addition, the user may increase MXSTEP to avoid this
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	652 C error return; see "Optional Inputs" below.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	653 C -2 Too much accuracy was requested for the precision of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	654 C the machine being used. This was detected before
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	655 C completing the requested task, but the integration
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	656 C was successful as far as T. To continue, the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	657 C tolerance parameters must be reset, and ISTATE must
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	658 C be set to 3. The optional output TOLSF may be used
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	659 C for this purpose. (Note: If this condition is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	660 C detected before taking any steps, then an illegal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	661 C input return (ISTATE = -3) occurs instead.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	662 C -3 Illegal input was detected, before taking any
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	663 C integration steps. See written message for details.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	664 C (Note: If the solver detects an infinite loop of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	665 C calls to the solver with illegal input, it will cause
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	666 C the run to stop.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	667 C -4 There were repeated error-test failures on one
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	668 C attempted step, before completing the requested task,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	669 C but the integration was successful as far as T. The
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	670 C problem may have a singularity, or the input may be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	671 C inappropriate.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	672 C -5 There were repeated convergence-test failures on one
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	673 C attempted step, before completing the requested task,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	674 C but the integration was successful as far as T. This
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	675 C may be caused by an inaccurate Jacobian matrix, if
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	676 C one is being used.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	677 C -6 EWT(i) became zero for some i during the integration.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	678 C Pure relative error control (ATOL(i)=0.0) was
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	679 C requested on a variable which has now vanished. The
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	680 C integration was successful as far as T.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	681 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	682 C Note: Since the normal output value of ISTATE is 2, it
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	683 C does not need to be reset for normal continuation. Also,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	684 C since a negative input value of ISTATE will be regarded
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	685 C as illegal, a negative output value requires the user to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	686 C change it, and possibly other inputs, before calling the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	687 C solver again.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	688 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	689 C IOPT An integer flag to specify whether any optional inputs
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	690 C are being used on this call. Input only. The optional
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	691 C inputs are listed under a separate heading below.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	692 C 0 No optional inputs are being used. Default values
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	693 C will be used in all cases.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	694 C 1 One or more optional inputs are being used.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	695 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	696 C RWORK A real working array (single precision). The length of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	697 C RWORK must be at least
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	698 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	699 C 20 + NYH(MAXORD + 1) + 3NEQ + LWM
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	700 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	701 C where
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	702 C NYH = the initial value of NEQ,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	703 C MAXORD = 12 (if METH = 1) or 5 (if METH = 2) (unless a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	704 C smaller value is given as an optional input),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	705 C LWM = 0 if MITER = 0,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	706 C LWM = NEQ**2 + 2 if MITER = 1 or 2,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	707 C LWM = NEQ + 2 if MITER = 3, and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	708 C LWM = (2ML + MU + 1)NEQ + 2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	709 C if MITER = 4 or 5.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	710 C (See the MF description below for METH and MITER.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	711 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	712 C Thus if MAXORD has its default value and NEQ is constant,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	713 C this length is:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	714 C 20 + 16*NEQ for MF = 10,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	715 C 22 + 16NEQ + NEQ*2 for MF = 11 or 12,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	716 C 22 + 17*NEQ for MF = 13,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	717 C 22 + 17NEQ + (2ML + MU)*NEQ for MF = 14 or 15,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	718 C 20 + 9*NEQ for MF = 20,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	719 C 22 + 9NEQ + NEQ*2 for MF = 21 or 22,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	720 C 22 + 10*NEQ for MF = 23,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	721 C 22 + 10NEQ + (2ML + MU)*NEQ for MF = 24 or 25.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	722 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	723 C The first 20 words of RWORK are reserved for conditional
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	724 C and optional inputs and optional outputs.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	725 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	726 C The following word in RWORK is a conditional input:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	727 C RWORK(1) = TCRIT, the critical value of t which the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	728 C solver is not to overshoot. Required if ITASK
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	729 C is 4 or 5, and ignored otherwise. See ITASK.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	730 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	731 C LRW The length of the array RWORK, as declared by the user.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	732 C (This will be checked by the solver.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	733 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	734 C IWORK An integer work array. Its length must be at least
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	735 C 20 if MITER = 0 or 3 (MF = 10, 13, 20, 23), or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	736 C 20 + NEQ otherwise (MF = 11, 12, 14, 15, 21, 22, 24, 25).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	737 C (See the MF description below for MITER.) The first few
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	738 C words of IWORK are used for conditional and optional
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	739 C inputs and optional outputs.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	740 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	741 C The following two words in IWORK are conditional inputs:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	742 C IWORK(1) = ML These are the lower and upper half-
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	743 C IWORK(2) = MU bandwidths, respectively, of the banded
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	744 C Jacobian, excluding the main diagonal.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	745 C The band is defined by the matrix locations
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	746 C (i,j) with i - ML <= j <= i + MU. ML and MU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	747 C must satisfy 0 <= ML,MU <= NEQ - 1. These are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	748 C required if MITER is 4 or 5, and ignored
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	749 C otherwise. ML and MU may in fact be the band
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	750 C parameters for a matrix to which df/dy is only
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	751 C approximately equal.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	752 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	753 C LIW The length of the array IWORK, as declared by the user.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	754 C (This will be checked by the solver.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	755 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	756 C Note: The work arrays must not be altered between calls to SLSODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	757 C for the same problem, except possibly for the conditional and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	758 C optional inputs, and except for the last 3*NEQ words of RWORK.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	759 C The latter space is used for internal scratch space, and so is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	760 C available for use by the user outside SLSODE between calls, if
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	761 C desired (but not for use by F or JAC).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	762 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	763 C JAC The name of the user-supplied routine (MITER = 1 or 4) to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	764 C compute the Jacobian matrix, df/dy, as a function of the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	765 C scalar t and the vector y. (See the MF description below
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	766 C for MITER.) It is to have the form
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	767 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	768 C SUBROUTINE JAC (NEQ, T, Y, ML, MU, PD, NROWPD)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	769 C REAL T, Y(), PD(NROWPD,)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	770 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	771 C where NEQ, T, Y, ML, MU, and NROWPD are input and the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	772 C array PD is to be loaded with partial derivatives
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	773 C (elements of the Jacobian matrix) on output. PD must be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	774 C given a first dimension of NROWPD. T and Y have the same
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	775 C meaning as in subroutine F.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	776 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	777 C In the full matrix case (MITER = 1), ML and MU are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	778 C ignored, and the Jacobian is to be loaded into PD in
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	779 C columnwise manner, with df(i)/dy(j) loaded into PD(i,j).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	780 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	781 C In the band matrix case (MITER = 4), the elements within
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	782 C the band are to be loaded into PD in columnwise manner,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	783 C with diagonal lines of df/dy loaded into the rows of PD.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	784 C Thus df(i)/dy(j) is to be loaded into PD(i-j+MU+1,j). ML
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	785 C and MU are the half-bandwidth parameters (see IWORK).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	786 C The locations in PD in the two triangular areas which
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	787 C correspond to nonexistent matrix elements can be ignored
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	788 C or loaded arbitrarily, as they are overwritten by SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	789 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	790 C JAC need not provide df/dy exactly. A crude approximation
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	791 C (possibly with a smaller bandwidth) will do.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	792 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	793 C In either case, PD is preset to zero by the solver, so
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	794 C that only the nonzero elements need be loaded by JAC.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	795 C Each call to JAC is preceded by a call to F with the same
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	796 C arguments NEQ, T, and Y. Thus to gain some efficiency,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	797 C intermediate quantities shared by both calculations may
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	798 C be saved in a user COMMON block by F and not recomputed
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	799 C by JAC, if desired. Also, JAC may alter the Y array, if
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	800 C desired. JAC must be declared EXTERNAL in the calling
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	801 C program.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	802 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	803 C Subroutine JAC may access user-defined quantities in
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	804 C NEQ(2),... and/or in Y(NEQ(1)+1),... if NEQ is an array
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	805 C (dimensioned in JAC) and/or Y has length exceeding
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	806 C NEQ(1). See the descriptions of NEQ and Y above.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	807 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	808 C MF The method flag. Used only for input. The legal values
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	809 C of MF are 10, 11, 12, 13, 14, 15, 20, 21, 22, 23, 24,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	810 C and 25. MF has decimal digits METH and MITER:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	811 C MF = 10*METH + MITER .
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	812 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	813 C METH indicates the basic linear multistep method:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	814 C 1 Implicit Adams method.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	815 C 2 Method based on backward differentiation formulas
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	816 C (BDF's).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	817 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	818 C MITER indicates the corrector iteration method:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	819 C 0 Functional iteration (no Jacobian matrix is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	820 C involved).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	821 C 1 Chord iteration with a user-supplied full (NEQ by
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	822 C NEQ) Jacobian.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	823 C 2 Chord iteration with an internally generated
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	824 C (difference quotient) full Jacobian (using NEQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	825 C extra calls to F per df/dy value).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	826 C 3 Chord iteration with an internally generated
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	827 C diagonal Jacobian approximation (using one extra call
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	828 C to F per df/dy evaluation).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	829 C 4 Chord iteration with a user-supplied banded Jacobian.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	830 C 5 Chord iteration with an internally generated banded
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	831 C Jacobian (using ML + MU + 1 extra calls to F per
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	832 C df/dy evaluation).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	833 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	834 C If MITER = 1 or 4, the user must supply a subroutine JAC
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	835 C (the name is arbitrary) as described above under JAC.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	836 C For other values of MITER, a dummy argument can be used.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	837 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	838 C Optional Inputs
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	839 C ---------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	840 C The following is a list of the optional inputs provided for in the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	841 C call sequence. (See also Part 2.) For each such input variable,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	842 C this table lists its name as used in this documentation, its
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	843 C location in the call sequence, its meaning, and the default value.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	844 C The use of any of these inputs requires IOPT = 1, and in that case
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	845 C all of these inputs are examined. A value of zero for any of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	846 C these optional inputs will cause the default value to be used.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	847 C Thus to use a subset of the optional inputs, simply preload
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	848 C locations 5 to 10 in RWORK and IWORK to 0.0 and 0 respectively,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	849 C and then set those of interest to nonzero values.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	850 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	851 C Name Location Meaning and default value
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	852 C ------ --------- -----------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	853 C H0 RWORK(5) Step size to be attempted on the first step.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	854 C The default value is determined by the solver.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	855 C HMAX RWORK(6) Maximum absolute step size allowed. The
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	856 C default value is infinite.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	857 C HMIN RWORK(7) Minimum absolute step size allowed. The
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	858 C default value is 0. (This lower bound is not
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	859 C enforced on the final step before reaching
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	860 C TCRIT when ITASK = 4 or 5.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	861 C MAXORD IWORK(5) Maximum order to be allowed. The default value
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	862 C is 12 if METH = 1, and 5 if METH = 2. (See the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	863 C MF description above for METH.) If MAXORD
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	864 C exceeds the default value, it will be reduced
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	865 C to the default value. If MAXORD is changed
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	866 C during the problem, it may cause the current
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	867 C order to be reduced.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	868 C MXSTEP IWORK(6) Maximum number of (internally defined) steps
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	869 C allowed during one call to the solver. The
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	870 C default value is 500.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	871 C MXHNIL IWORK(7) Maximum number of messages printed (per
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	872 C problem) warning that T + H = T on a step
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	873 C (H = step size). This must be positive to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	874 C result in a nondefault value. The default
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	875 C value is 10.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	876 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	877 C Optional Outputs
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	878 C ----------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	879 C As optional additional output from SLSODE, the variables listed
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	880 C below are quantities related to the performance of SLSODE which
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	881 C are available to the user. These are communicated by way of the
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	882 C work arrays, but also have internal mnemonic names as shown.
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	883 C Except where stated otherwise, all of these outputs are defined on
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	884 C any successful return from SLSODE, and on any return with ISTATE =
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	885 C -1, -2, -4, -5, or -6. On an illegal input return (ISTATE = -3),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	886 C they will be unchanged from their existing values (if any), except
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	887 C possibly for TOLSF, LENRW, and LENIW. On any error return,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	888 C outputs relevant to the error will be defined, as noted below.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	889 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	890 C Name Location Meaning
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	891 C ----- --------- ------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	892 C HU RWORK(11) Step size in t last used (successfully).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	893 C HCUR RWORK(12) Step size to be attempted on the next step.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	894 C TCUR RWORK(13) Current value of the independent variable which
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	895 C the solver has actually reached, i.e., the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	896 C current internal mesh point in t. On output,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	897 C TCUR will always be at least as far as the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	898 C argument T, but may be farther (if interpolation
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	899 C was done).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	900 C TOLSF RWORK(14) Tolerance scale factor, greater than 1.0,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	901 C computed when a request for too much accuracy
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	902 C was detected (ISTATE = -3 if detected at the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	903 C start of the problem, ISTATE = -2 otherwise).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	904 C If ITOL is left unaltered but RTOL and ATOL are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	905 C uniformly scaled up by a factor of TOLSF for the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	906 C next call, then the solver is deemed likely to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	907 C succeed. (The user may also ignore TOLSF and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	908 C alter the tolerance parameters in any other way
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	909 C appropriate.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	910 C NST IWORK(11) Number of steps taken for the problem so far.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	911 C NFE IWORK(12) Number of F evaluations for the problem so far.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	912 C NJE IWORK(13) Number of Jacobian evaluations (and of matrix LU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	913 C decompositions) for the problem so far.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	914 C NQU IWORK(14) Method order last used (successfully).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	915 C NQCUR IWORK(15) Order to be attempted on the next step.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	916 C IMXER IWORK(16) Index of the component of largest magnitude in
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	917 C the weighted local error vector ( e(i)/EWT(i) ),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	918 C on an error return with ISTATE = -4 or -5.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	919 C LENRW IWORK(17) Length of RWORK actually required. This is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	920 C defined on normal returns and on an illegal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	921 C input return for insufficient storage.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	922 C LENIW IWORK(18) Length of IWORK actually required. This is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	923 C defined on normal returns and on an illegal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	924 C input return for insufficient storage.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	925 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	926 C The following two arrays are segments of the RWORK array which may
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	927 C also be of interest to the user as optional outputs. For each
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	928 C array, the table below gives its internal name, its base address
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	929 C in RWORK, and its description.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	930 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	931 C Name Base address Description
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	932 C ---- ------------ ----------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	933 C YH 21 The Nordsieck history array, of size NYH by
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	934 C (NQCUR + 1), where NYH is the initial value of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	935 C NEQ. For j = 0,1,...,NQCUR, column j + 1 of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	936 C YH contains HCUR**j/factorial(j) times the jth
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	937 C derivative of the interpolating polynomial
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	938 C currently representing the solution, evaluated
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	939 C at t = TCUR.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	940 C ACOR LENRW-NEQ+1 Array of size NEQ used for the accumulated
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	941 C corrections on each step, scaled on output to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	942 C represent the estimated local error in Y on
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	943 C the last step. This is the vector e in the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	944 C description of the error control. It is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	945 C defined only on successful return from SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	946 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	947 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	948 C Part 2. Other Callable Routines
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	949 C --------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	950 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	951 C The following are optional calls which the user may make to gain
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	952 C additional capabilities in conjunction with SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	953 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	954 C Form of call Function
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	955 C ------------------------ ----------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	956 C CALL XSETUN(LUN) Set the logical unit number, LUN, for
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	957 C output of messages from SLSODE, if the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	958 C default is not desired. The default
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	959 C value of LUN is 6. This call may be made
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	960 C at any time and will take effect
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	961 C immediately.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	962 C CALL XSETF(MFLAG) Set a flag to control the printing of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	963 C messages by SLSODE. MFLAG = 0 means do
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	964 C not print. (Danger: this risks losing
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	965 C valuable information.) MFLAG = 1 means
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	966 C print (the default). This call may be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	967 C made at any time and will take effect
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	968 C immediately.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	969 C CALL SSRCOM(RSAV,ISAV,JOB) Saves and restores the contents of the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	970 C internal COMMON blocks used by SLSODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	971 C (see Part 3 below). RSAV must be a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	972 C real array of length 218 or more, and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	973 C ISAV must be an integer array of length
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	974 C 37 or more. JOB = 1 means save COMMON
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	975 C into RSAV/ISAV. JOB = 2 means restore
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	976 C COMMON from same. SSRCOM is useful if
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	977 C one is interrupting a run and restarting
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	978 C later, or alternating between two or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	979 C more problems solved with SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	980 C CALL SINTDY(,,,,,) Provide derivatives of y, of various
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	981 C (see below) orders, at a specified point t, if
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	982 C desired. It may be called only after a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	983 C successful return from SLSODE. Detailed
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	984 C instructions follow.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	985 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	986 C Detailed instructions for using SINTDY
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	987 C --------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	988 C The form of the CALL is:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	989 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	990 C CALL SINTDY (T, K, RWORK(21), NYH, DKY, IFLAG)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	991 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	992 C The input parameters are:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	993 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	994 C T Value of independent variable where answers are
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	995 C desired (normally the same as the T last returned by
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	996 C SLSODE). For valid results, T must lie between
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	997 C TCUR - HU and TCUR. (See "Optional Outputs" above
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	998 C for TCUR and HU.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	999 C K Integer order of the derivative desired. K must
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1000 C satisfy 0 <= K <= NQCUR, where NQCUR is the current
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1001 C order (see "Optional Outputs"). The capability
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1002 C corresponding to K = 0, i.e., computing y(t), is
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1003 C already provided by SLSODE directly. Since
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1004 C NQCUR >= 1, the first derivative dy/dt is always
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1005 C available with SINTDY.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1006 C RWORK(21) The base address of the history array YH.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1007 C NYH Column length of YH, equal to the initial value of NEQ.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1008 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1009 C The output parameters are:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1010 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1011 C DKY Real array of length NEQ containing the computed value
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1012 C of the Kth derivative of y(t).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1013 C IFLAG Integer flag, returned as 0 if K and T were legal,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1014 C -1 if K was illegal, and -2 if T was illegal.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1015 C On an error return, a message is also written.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1016 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1017 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1018 C Part 3. Common Blocks
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1019 C ----------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1020 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1021 C If SLSODE is to be used in an overlay situation, the user must
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1022 C declare, in the primary overlay, the variables in:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1023 C (1) the call sequence to SLSODE,
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1024 C (2) the internal COMMON block /SLS001/, of length 255
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1025 C (218 single precision words followed by 37 integer words).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1026 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1027 C If SLSODE is used on a system in which the contents of internal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1028 C COMMON blocks are not preserved between calls, the user should
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1029 C declare the above COMMON block in his main program to insure that
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1030 C its contents are preserved.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1031 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1032 C If the solution of a given problem by SLSODE is to be interrupted
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1033 C and then later continued, as when restarting an interrupted run or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1034 C alternating between two or more problems, the user should save,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1035 C following the return from the last SLSODE call prior to the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1036 C interruption, the contents of the call sequence variables and the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1037 C internal COMMON block, and later restore these values before the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1038 C next SLSODE call for that problem. In addition, if XSETUN and/or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1039 C XSETF was called for non-default handling of error messages, then
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1040 C these calls must be repeated. To save and restore the COMMON
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1041 C block, use subroutine SSRCOM (see Part 2 above).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1042 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1043 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1044 C Part 4. Optionally Replaceable Solver Routines
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1045 C -----------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1046 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1047 C Below are descriptions of two routines in the SLSODE package which
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1048 C relate to the measurement of errors. Either routine can be
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1049 C replaced by a user-supplied version, if desired. However, since
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1050 C such a replacement may have a major impact on performance, it
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1051 C should be done only when absolutely necessary, and only with great
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1052 C caution. (Note: The means by which the package version of a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1053 C routine is superseded by the user's version may be system-
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1054 C dependent.)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1055 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1056 C SEWSET
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1057 C ------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1058 C The following subroutine is called just before each internal
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1059 C integration step, and sets the array of error weights, EWT, as
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1060 C described under ITOL/RTOL/ATOL above:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1061 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1062 C SUBROUTINE SEWSET (NEQ, ITOL, RTOL, ATOL, YCUR, EWT)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1063 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1064 C where NEQ, ITOL, RTOL, and ATOL are as in the SLSODE call
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1065 C sequence, YCUR contains the current dependent variable vector,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1066 C and EWT is the array of weights set by SEWSET.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1067 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1068 C If the user supplies this subroutine, it must return in EWT(i)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1069 C (i = 1,...,NEQ) a positive quantity suitable for comparing errors
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1070 C in Y(i) to. The EWT array returned by SEWSET is passed to the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1071 C SVNORM routine (see below), and also used by SLSODE in the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1072 C computation of the optional output IMXER, the diagonal Jacobian
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1073 C approximation, and the increments for difference quotient
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1074 C Jacobians.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1075 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1076 C In the user-supplied version of SEWSET, it may be desirable to use
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1077 C the current values of derivatives of y. Derivatives up to order NQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1078 C are available from the history array YH, described above under
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1079 C optional outputs. In SEWSET, YH is identical to the YCUR array,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1080 C extended to NQ + 1 columns with a column length of NYH and scale
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1081 C factors of H**j/factorial(j). On the first call for the problem,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1082 C given by NST = 0, NQ is 1 and H is temporarily set to 1.0.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1083 C NYH is the initial value of NEQ. The quantities NQ, H, and NST
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1084 C can be obtained by including in SEWSET the statements:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1085 C REAL RLS
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1086 C COMMON /SLS001/ RLS(218),ILS(37)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1087 C NQ = ILS(33)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1088 C NST = ILS(34)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1089 C H = RLS(212)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1090 C Thus, for example, the current value of dy/dt can be obtained as
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1091 C YCUR(NYH+i)/H (i=1,...,NEQ) (and the division by H is unnecessary
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1092 C when NST = 0).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1093 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1094 C SVNORM
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1095 C ------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1096 C SVNORM is a real function routine which computes the weighted
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1097 C root-mean-square norm of a vector v:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1098 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1099 C d = SVNORM (n, v, w)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1100 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1101 C where:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1102 C n = the length of the vector,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1103 C v = real array of length n containing the vector,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1104 C w = real array of length n containing weights,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1105 C d = SQRT( (1/n) * sum(v(i)w(i))*2 ).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1106 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1107 C SVNORM is called with n = NEQ and with w(i) = 1.0/EWT(i), where
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1108 C EWT is as set by subroutine SEWSET.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1109 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1110 C If the user supplies this function, it should return a nonnegative
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1111 C value of SVNORM suitable for use in the error control in SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1112 C None of the arguments should be altered by SVNORM. For example, a
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1113 C user-supplied SVNORM routine might:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1114 C - Substitute a max-norm of (v(i)*w(i)) for the rms-norm, or
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1115 C - Ignore some components of v in the norm, with the effect of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1116 C suppressing the error control on those components of Y.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1117 C ---------------------------------------------------------------------
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1118 C***ROUTINES CALLED SEWSET, SINTDY, D1MACH, SSTODE, SVNORM, XERRWD
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1119 C***COMMON BLOCKS SLS001
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1120 C***REVISION HISTORY (YYYYMMDD)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1121 C 19791129 DATE WRITTEN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1122 C 19791213 Minor changes to declarations; DELP init. in STODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1123 C 19800118 Treat NEQ as array; integer declarations added throughout;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1124 C minor changes to prologue.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1125 C 19800306 Corrected TESCO(1,NQP1) setting in CFODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1126 C 19800519 Corrected access of YH on forced order reduction;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1127 C numerous corrections to prologues and other comments.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1128 C 19800617 In main driver, added loading of SQRT(UROUND) in RWORK;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1129 C minor corrections to main prologue.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1130 C 19800923 Added zero initialization of HU and NQU.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1131 C 19801218 Revised XERRWV routine; minor corrections to main prologue.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1132 C 19810401 Minor changes to comments and an error message.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1133 C 19810814 Numerous revisions: replaced EWT by 1/EWT; used flags
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1134 C JCUR, ICF, IERPJ, IERSL between STODE and subordinates;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1135 C added tuning parameters CCMAX, MAXCOR, MSBP, MXNCF;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1136 C reorganized returns from STODE; reorganized type decls.;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1137 C fixed message length in XERRWV; changed default LUNIT to 6;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1138 C changed Common lengths; changed comments throughout.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1139 C 19870330 Major update by ACH: corrected comments throughout;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1140 C removed TRET from Common; rewrote EWSET with 4 loops;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1141 C fixed t test in INTDY; added Cray directives in STODE;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1142 C in STODE, fixed DELP init. and logic around PJAC call;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1143 C combined routines to save/restore Common;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1144 C passed LEVEL = 0 in error message calls (except run abort).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1145 C 19890426 Modified prologue to SLATEC/LDOC format. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1146 C 19890501 Many improvements to prologue. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1147 C 19890503 A few final corrections to prologue. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1148 C 19890504 Minor cosmetic changes. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1149 C 19890510 Corrected description of Y in Arguments section. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1150 C 19890517 Minor corrections to prologue. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1151 C 19920514 Updated with prologue edited 891025 by G. Shaw for manual.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1152 C 19920515 Converted source lines to upper case. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1153 C 19920603 Revised XERRWV calls using mixed upper-lower case. (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1154 C 19920616 Revised prologue comment regarding CFT. (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1155 C 19921116 Revised prologue comments regarding Common. (ACH).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1156 C 19930326 Added comment about non-reentrancy. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1157 C 19930723 Changed R1MACH to RUMACH. (FNF)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1158 C 19930801 Removed ILLIN and NTREP from Common (affects driver logic);
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1159 C minor changes to prologue and internal comments;
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1160 C changed Hollerith strings to quoted strings;
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1161 C changed internal comments to mixed case;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1162 C replaced XERRWV with new version using character type;
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1163 C changed dummy dimensions from 1 to *. (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1164 C 19930809 Changed to generic intrinsic names; changed names of
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1165 C subprograms and Common blocks to SLSODE etc. (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1166 C 19930929 Eliminated use of REAL intrinsic; other minor changes. (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1167 C 20010412 Removed all 'own' variables from Common block /SLS001/
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1168 C (affects declarations in 6 routines). (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1169 C 20010509 Minor corrections to prologue. (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1170 C 20031105 Restored 'own' variables to Common block /SLS001/, to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1171 C enable interrupt/restart feature. (ACH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1172 C 20031112 Added SAVE statements for data-loaded constants.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1173 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1174 C*** END PROLOGUE SLSODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1175 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1176 C*Internal Notes:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1177 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1178 C Other Routines in the SLSODE Package.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1179 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1180 C In addition to Subroutine SLSODE, the SLSODE package includes the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1181 C following subroutines and function routines:
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1182 C SINTDY computes an interpolated value of the y vector at t = TOUT.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1183 C SSTODE is the core integrator, which does one step of the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1184 C integration and the associated error control.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1185 C SCFODE sets all method coefficients and test constants.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1186 C SPREPJ computes and preprocesses the Jacobian matrix J = df/dy
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1187 C and the Newton iteration matrix P = I - hl0J.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1188 C SSOLSY manages solution of linear system in chord iteration.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1189 C SEWSET sets the error weight vector EWT before each step.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1190 C SVNORM computes the weighted R.M.S. norm of a vector.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1191 C SSRCOM is a user-callable routine to save and restore
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1192 C the contents of the internal Common block.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1193 C DGETRF AND DGETRS ARE ROUTINES FROM LAPACK FOR SOLVING FULL
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1194 C SYSTEMS OF LINEAR ALGEBRAIC EQUATIONS.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1195 C DGBTRF AND DGBTRS ARE ROUTINES FROM LAPACK FOR SOLVING BANDED
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1196 C LINEAR SYSTEMS.
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1197 C D1MACH computes the unit roundoff in a machine-independent manner.
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1198 C XERRWD, XSETUN, XSETF, IXSAV, IUMACH handle the printing of all
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1199 C error messages and warnings. XERRWD is machine-dependent.
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1200 C Note: SVNORM, D1MACH, IXSAV, and IUMACH are function routines.
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1201 C All the others are subroutines.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1202 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1203 C**End
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1204 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1205 C Declare externals.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1206 EXTERNAL SPREPJ, SSOLSY
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1207 REAL D1MACH, SVNORM
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1208 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1209 C Declare all other variables.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1210 INTEGER INIT, MXSTEP, MXHNIL, NHNIL, NSLAST, NYH, IOWNS,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1211 1 ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1212 2 LYH, LEWT, LACOR, LSAVF, LWM, LIWM, METH, MITER,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1213 3 MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1214 INTEGER I, I1, I2, IFLAG, IMXER, KGO, LF0,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1215 1 LENIW, LENRW, LENWM, ML, MORD, MU, MXHNL0, MXSTP0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1216 REAL ROWNS,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1217 1 CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1218 REAL ATOLI, AYI, BIG, EWTI, H0, HMAX, HMX, RH, RTOLI,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1219 1 TCRIT, TDIST, TNEXT, TOL, TOLSF, TP, SIZE, SUM, W0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1220 DIMENSION MORD(2)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1221 LOGICAL IHIT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1222 CHARACTER*80 MSG
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1223 SAVE MORD, MXSTP0, MXHNL0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1224 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1225 C The following internal Common block contains
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1226 C (a) variables which are local to any subroutine but whose values must
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1227 C be preserved between calls to the routine ("own" variables), and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1228 C (b) variables which are communicated between subroutines.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1229 C The block SLS001 is declared in subroutines SLSODE, SINTDY, SSTODE,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1230 C SPREPJ, and SSOLSY.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1231 C Groups of variables are replaced by dummy arrays in the Common
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1232 C declarations in routines where those variables are not used.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1233 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1234 COMMON /SLS001/ ROWNS(209),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1235 1 CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1236 2 INIT, MXSTEP, MXHNIL, NHNIL, NSLAST, NYH, IOWNS(6),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1237 3 ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1238 4 LYH, LEWT, LACOR, LSAVF, LWM, LIWM, METH, MITER,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1239 5 MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1240 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1241 DATA MORD(1),MORD(2)/12,5/, MXSTP0/500/, MXHNL0/10/
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1242 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1243 C Block A.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1244 C This code block is executed on every call.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1245 C It tests ISTATE and ITASK for legality and branches appropriately.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1246 C If ISTATE .GT. 1 but the flag INIT shows that initialization has
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1247 C not yet been done, an error return occurs.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1248 C If ISTATE = 1 and TOUT = T, return immediately.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1249 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1250 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1251 C***FIRST EXECUTABLE STATEMENT SLSODE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1252 IF (ISTATE .LT. 1 .OR. ISTATE .GT. 3) GO TO 601
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1253 IF (ITASK .LT. 1 .OR. ITASK .GT. 5) GO TO 602
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1254 IF (ISTATE .EQ. 1) GO TO 10
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1255 IF (INIT .EQ. 0) GO TO 603
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1256 IF (ISTATE .EQ. 2) GO TO 200
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1257 GO TO 20
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1258 10 INIT = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1259 IF (TOUT .EQ. T) RETURN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1260 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1261 C Block B.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1262 C The next code block is executed for the initial call (ISTATE = 1),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1263 C or for a continuation call with parameter changes (ISTATE = 3).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1264 C It contains checking of all inputs and various initializations.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1265 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1266 C First check legality of the non-optional inputs NEQ, ITOL, IOPT,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1267 C MF, ML, and MU.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1268 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1269 20 IF (NEQ(1) .LE. 0) GO TO 604
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1270 IF (ISTATE .EQ. 1) GO TO 25
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1271 IF (NEQ(1) .GT. N) GO TO 605
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1272 25 N = NEQ(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1273 IF (ITOL .LT. 1 .OR. ITOL .GT. 4) GO TO 606
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1274 IF (IOPT .LT. 0 .OR. IOPT .GT. 1) GO TO 607
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1275 METH = MF/10
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1276 MITER = MF - 10*METH
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1277 IF (METH .LT. 1 .OR. METH .GT. 2) GO TO 608
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1278 IF (MITER .LT. 0 .OR. MITER .GT. 5) GO TO 608
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1279 IF (MITER .LE. 3) GO TO 30
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1280 ML = IWORK(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1281 MU = IWORK(2)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1282 IF (ML .LT. 0 .OR. ML .GE. N) GO TO 609
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1283 IF (MU .LT. 0 .OR. MU .GE. N) GO TO 610
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1284 30 CONTINUE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1285 C Next process and check the optional inputs. --------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1286 IF (IOPT .EQ. 1) GO TO 40
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1287 MAXORD = MORD(METH)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1288 MXSTEP = MXSTP0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1289 MXHNIL = MXHNL0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1290 IF (ISTATE .EQ. 1) H0 = 0.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1291 HMXI = 0.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1292 HMIN = 0.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1293 GO TO 60
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1294 40 MAXORD = IWORK(5)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1295 IF (MAXORD .LT. 0) GO TO 611
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1296 IF (MAXORD .EQ. 0) MAXORD = 100
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1297 MAXORD = MIN(MAXORD,MORD(METH))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1298 MXSTEP = IWORK(6)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1299 IF (MXSTEP .LT. 0) GO TO 612
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1300 IF (MXSTEP .EQ. 0) MXSTEP = MXSTP0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1301 MXHNIL = IWORK(7)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1302 IF (MXHNIL .LT. 0) GO TO 613
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1303 IF (MXHNIL .EQ. 0) MXHNIL = MXHNL0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1304 IF (ISTATE .NE. 1) GO TO 50
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1305 H0 = RWORK(5)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1306 IF ((TOUT - T)*H0 .LT. 0.0E0) GO TO 614
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1307 50 HMAX = RWORK(6)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1308 IF (HMAX .LT. 0.0E0) GO TO 615
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1309 HMXI = 0.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1310 IF (HMAX .GT. 0.0E0) HMXI = 1.0E0/HMAX
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1311 HMIN = RWORK(7)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1312 IF (HMIN .LT. 0.0E0) GO TO 616
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1313 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1314 C Set work array pointers and check lengths LRW and LIW.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1315 C Pointers to segments of RWORK and IWORK are named by prefixing L to
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1316 C the name of the segment. E.g., the segment YH starts at RWORK(LYH).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1317 C Segments of RWORK (in order) are denoted YH, WM, EWT, SAVF, ACOR.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1318 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1319 60 LYH = 21
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1320 IF (ISTATE .EQ. 1) NYH = N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1321 LWM = LYH + (MAXORD + 1)*NYH
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1322 IF (MITER .EQ. 0) LENWM = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1323 IF (MITER .EQ. 1 .OR. MITER .EQ. 2) LENWM = N*N + 2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1324 IF (MITER .EQ. 3) LENWM = N + 2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1325 IF (MITER .GE. 4) LENWM = (2ML + MU + 1)N + 2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1326 LEWT = LWM + LENWM
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1327 LSAVF = LEWT + N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1328 LACOR = LSAVF + N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1329 LENRW = LACOR + N - 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1330 IWORK(17) = LENRW
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1331 LIWM = 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1332 LENIW = 20 + N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1333 IF (MITER .EQ. 0 .OR. MITER .EQ. 3) LENIW = 20
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1334 IWORK(18) = LENIW
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1335 IF (LENRW .GT. LRW) GO TO 617
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1336 IF (LENIW .GT. LIW) GO TO 618
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1337 C Check RTOL and ATOL for legality. ------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1338 RTOLI = RTOL(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1339 ATOLI = ATOL(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1340 DO 70 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1341 IF (ITOL .GE. 3) RTOLI = RTOL(I)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1342 IF (ITOL .EQ. 2 .OR. ITOL .EQ. 4) ATOLI = ATOL(I)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1343 IF (RTOLI .LT. 0.0E0) GO TO 619
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1344 IF (ATOLI .LT. 0.0E0) GO TO 620
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1345 70 CONTINUE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1346 IF (ISTATE .EQ. 1) GO TO 100
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1347 C If ISTATE = 3, set flag to signal parameter changes to SSTODE. -------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1348 JSTART = -1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1349 IF (NQ .LE. MAXORD) GO TO 90
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1350 C MAXORD was reduced below NQ. Copy YH(*,MAXORD+2) into SAVF. ---------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1351 DO 80 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1352 80 RWORK(I+LSAVF-1) = RWORK(I+LWM-1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1353 C Reload WM(1) = RWORK(LWM), since LWM may have changed. ---------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1354 90 IF (MITER .GT. 0) RWORK(LWM) = SQRT(UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1355 IF (N .EQ. NYH) GO TO 200
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1356 C NEQ was reduced. Zero part of YH to avoid undefined references. -----
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1357 I1 = LYH + L*NYH
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1358 I2 = LYH + (MAXORD + 1)*NYH - 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1359 IF (I1 .GT. I2) GO TO 200
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1360 DO 95 I = I1,I2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1361 95 RWORK(I) = 0.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1362 GO TO 200
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1363 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1364 C Block C.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1365 C The next block is for the initial call only (ISTATE = 1).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1366 C It contains all remaining initializations, the initial call to F,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1367 C and the calculation of the initial step size.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1368 C The error weights in EWT are inverted after being loaded.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1369 C-----------------------------------------------------------------------
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1370 100 UROUND = D1MACH(4)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1371 TN = T
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1372 IF (ITASK .NE. 4 .AND. ITASK .NE. 5) GO TO 110
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1373 TCRIT = RWORK(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1374 IF ((TCRIT - TOUT)*(TOUT - T) .LT. 0.0E0) GO TO 625
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1375 IF (H0 .NE. 0.0E0 .AND. (T + H0 - TCRIT)*H0 .GT. 0.0E0)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1376 1 H0 = TCRIT - T
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1377 110 JSTART = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1378 IF (MITER .GT. 0) RWORK(LWM) = SQRT(UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1379 NHNIL = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1380 NST = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1381 NJE = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1382 NSLAST = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1383 HU = 0.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1384 NQU = 0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1385 CCMAX = 0.3E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1386 MAXCOR = 3
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1387 MSBP = 20
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1388 MXNCF = 10
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1389 C Initial call to F. (LF0 points to YH(*,2).) -------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1390 LF0 = LYH + NYH
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1391 CALL F (NEQ, T, Y, RWORK(LF0))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1392 NFE = 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1393 C Load the initial value vector in YH. ---------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1394 DO 115 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1395 115 RWORK(I+LYH-1) = Y(I)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1396 C Load and invert the EWT array. (H is temporarily set to 1.0.) -------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1397 NQ = 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1398 H = 1.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1399 CALL SEWSET (N, ITOL, RTOL, ATOL, RWORK(LYH), RWORK(LEWT))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1400 DO 120 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1401 IF (RWORK(I+LEWT-1) .LE. 0.0E0) GO TO 621
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1402 120 RWORK(I+LEWT-1) = 1.0E0/RWORK(I+LEWT-1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1403 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1404 C The coding below computes the step size, H0, to be attempted on the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1405 C first step, unless the user has supplied a value for this.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1406 C First check that TOUT - T differs significantly from zero.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1407 C A scalar tolerance quantity TOL is computed, as MAX(RTOL(I))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1408 C if this is positive, or MAX(ATOL(I)/ABS(Y(I))) otherwise, adjusted
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1409 C so as to be between 100*UROUND and 1.0E-3.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1410 C Then the computed value H0 is given by..
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1411 C NEQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1412 C H02 = TOL / ( w0-2 + (1/NEQ) * SUM ( f(i)/ywt(i) )**2 )
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1413 C 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1414 C where w0 = MAX ( ABS(T), ABS(TOUT) ),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1415 C f(i) = i-th component of initial value of f,
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1416 C ywt(i) = EWT(i)/TOL (a weight for y(i)).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1417 C The sign of H0 is inferred from the initial values of TOUT and T.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1418 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1419 IF (H0 .NE. 0.0E0) GO TO 180
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1420 TDIST = ABS(TOUT - T)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1421 W0 = MAX(ABS(T),ABS(TOUT))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1422 IF (TDIST .LT. 2.0E0UROUNDW0) GO TO 622
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1423 TOL = RTOL(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1424 IF (ITOL .LE. 2) GO TO 140
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1425 DO 130 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1426 130 TOL = MAX(TOL,RTOL(I))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1427 140 IF (TOL .GT. 0.0E0) GO TO 160
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1428 ATOLI = ATOL(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1429 DO 150 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1430 IF (ITOL .EQ. 2 .OR. ITOL .EQ. 4) ATOLI = ATOL(I)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1431 AYI = ABS(Y(I))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1432 IF (AYI .NE. 0.0E0) TOL = MAX(TOL,ATOLI/AYI)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1433 150 CONTINUE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1434 160 TOL = MAX(TOL,100.0E0*UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1435 TOL = MIN(TOL,0.001E0)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1436 SUM = SVNORM (N, RWORK(LF0), RWORK(LEWT))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1437 SUM = 1.0E0/(TOLW0W0) + TOLSUM*2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1438 H0 = 1.0E0/SQRT(SUM)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1439 H0 = MIN(H0,TDIST)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1440 H0 = SIGN(H0,TOUT-T)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1441 C Adjust H0 if necessary to meet HMAX bound. ---------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1442 180 RH = ABS(H0)*HMXI
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1443 IF (RH .GT. 1.0E0) H0 = H0/RH
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1444 C Load H with H0 and scale YH(*,2) by H0. ------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1445 H = H0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1446 DO 190 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1447 190 RWORK(I+LF0-1) = H0*RWORK(I+LF0-1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1448 GO TO 270
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1449 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1450 C Block D.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1451 C The next code block is for continuation calls only (ISTATE = 2 or 3)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1452 C and is to check stop conditions before taking a step.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1453 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1454 200 NSLAST = NST
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1455 GO TO (210, 250, 220, 230, 240), ITASK
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1456 210 IF ((TN - TOUT)*H .LT. 0.0E0) GO TO 250
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1457 CALL SINTDY (TOUT, 0, RWORK(LYH), NYH, Y, IFLAG)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1458 IF (IFLAG .NE. 0) GO TO 627
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1459 T = TOUT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1460 GO TO 420
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1461 220 TP = TN - HU(1.0E0 + 100.0E0UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1462 IF ((TP - TOUT)*H .GT. 0.0E0) GO TO 623
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1463 IF ((TN - TOUT)*H .LT. 0.0E0) GO TO 250
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1464 GO TO 400
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1465 230 TCRIT = RWORK(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1466 IF ((TN - TCRIT)*H .GT. 0.0E0) GO TO 624
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1467 IF ((TCRIT - TOUT)*H .LT. 0.0E0) GO TO 625
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1468 IF ((TN - TOUT)*H .LT. 0.0E0) GO TO 245
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1469 CALL SINTDY (TOUT, 0, RWORK(LYH), NYH, Y, IFLAG)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1470 IF (IFLAG .NE. 0) GO TO 627
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1471 T = TOUT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1472 GO TO 420
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1473 240 TCRIT = RWORK(1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1474 IF ((TN - TCRIT)*H .GT. 0.0E0) GO TO 624
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1475 245 HMX = ABS(TN) + ABS(H)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1476 IHIT = ABS(TN - TCRIT) .LE. 100.0E0UROUNDHMX
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1477 IF (IHIT) GO TO 400
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1478 TNEXT = TN + H(1.0E0 + 4.0E0UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1479 IF ((TNEXT - TCRIT)*H .LE. 0.0E0) GO TO 250
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1480 H = (TCRIT - TN)(1.0E0 - 4.0E0UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1481 IF (ISTATE .EQ. 2) JSTART = -2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1482 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1483 C Block E.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1484 C The next block is normally executed for all calls and contains
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1485 C the call to the one-step core integrator SSTODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1486 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1487 C This is a looping point for the integration steps.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1488 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1489 C First check for too many steps being taken, update EWT (if not at
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1490 C start of problem), check for too much accuracy being requested, and
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1491 C check for H below the roundoff level in T.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1492 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1493 250 CONTINUE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1494 IF ((NST-NSLAST) .GE. MXSTEP) GO TO 500
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1495 CALL SEWSET (N, ITOL, RTOL, ATOL, RWORK(LYH), RWORK(LEWT))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1496 DO 260 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1497 IF (RWORK(I+LEWT-1) .LE. 0.0E0) GO TO 510
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1498 260 RWORK(I+LEWT-1) = 1.0E0/RWORK(I+LEWT-1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1499 270 TOLSF = UROUND*SVNORM (N, RWORK(LYH), RWORK(LEWT))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1500 IF (TOLSF .LE. 1.0E0) GO TO 280
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1501 TOLSF = TOLSF*2.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1502 IF (NST .EQ. 0) GO TO 626
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1503 GO TO 520
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1504 280 IF ((TN + H) .NE. TN) GO TO 290
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1505 NHNIL = NHNIL + 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1506 IF (NHNIL .GT. MXHNIL) GO TO 290
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1507 CALL XERRWD('SLSODE- Warning..internal T (=R1) and H (=R2) are',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1508 1 50, 101, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1509 CALL XERRWD(
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1510 1 ' such that in the machine, T + H = T on the next step ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1511 1 60, 101, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1512 CALL XERRWD(' (H = step size). Solver will continue anyway',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1513 1 50, 101, 0, 0, 0, 0, 2, TN, H)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1514 IF (NHNIL .LT. MXHNIL) GO TO 290
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1515 CALL XERRWD('SLSODE- Above warning has been issued I1 times. ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1516 1 50, 102, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1517 CALL XERRWD(' It will not be issued again for this problem',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1518 1 50, 102, 0, 1, MXHNIL, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1519 290 CONTINUE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1520 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1521 C CALL SSTODE(NEQ,Y,YH,NYH,YH,EWT,SAVF,ACOR,WM,IWM,F,JAC,SPREPJ,SSOLSY)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1522 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1523 CALL SSTODE (NEQ, Y, RWORK(LYH), NYH, RWORK(LYH), RWORK(LEWT),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1524 1 RWORK(LSAVF), RWORK(LACOR), RWORK(LWM), IWORK(LIWM),
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1525 2 F, JAC, SPREPJ, SSOLSY)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1526 KGO = 1 - KFLAG
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1527 GO TO (300, 530, 540), KGO
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1528 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1529 C Block F.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1530 C The following block handles the case of a successful return from the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1531 C core integrator (KFLAG = 0). Test for stop conditions.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1532 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1533 300 INIT = 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1534 GO TO (310, 400, 330, 340, 350), ITASK
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1535 C ITASK = 1. If TOUT has been reached, interpolate. -------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1536 310 IF ((TN - TOUT)*H .LT. 0.0E0) GO TO 250
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1537 CALL SINTDY (TOUT, 0, RWORK(LYH), NYH, Y, IFLAG)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1538 T = TOUT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1539 GO TO 420
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1540 C ITASK = 3. Jump to exit if TOUT was reached. ------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1541 330 IF ((TN - TOUT)*H .GE. 0.0E0) GO TO 400
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1542 GO TO 250
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1543 C ITASK = 4. See if TOUT or TCRIT was reached. Adjust H if necessary.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1544 340 IF ((TN - TOUT)*H .LT. 0.0E0) GO TO 345
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1545 CALL SINTDY (TOUT, 0, RWORK(LYH), NYH, Y, IFLAG)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1546 T = TOUT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1547 GO TO 420
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1548 345 HMX = ABS(TN) + ABS(H)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1549 IHIT = ABS(TN - TCRIT) .LE. 100.0E0UROUNDHMX
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1550 IF (IHIT) GO TO 400
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1551 TNEXT = TN + H(1.0E0 + 4.0E0UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1552 IF ((TNEXT - TCRIT)*H .LE. 0.0E0) GO TO 250
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1553 H = (TCRIT - TN)(1.0E0 - 4.0E0UROUND)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1554 JSTART = -2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1555 GO TO 250
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1556 C ITASK = 5. See if TCRIT was reached and jump to exit. ---------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1557 350 HMX = ABS(TN) + ABS(H)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1558 IHIT = ABS(TN - TCRIT) .LE. 100.0E0UROUNDHMX
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1559 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1560 C Block G.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1561 C The following block handles all successful returns from SLSODE.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1562 C If ITASK .NE. 1, Y is loaded from YH and T is set accordingly.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1563 C ISTATE is set to 2, and the optional outputs are loaded into the
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1564 C work arrays before returning.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1565 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1566 400 DO 410 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1567 410 Y(I) = RWORK(I+LYH-1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1568 T = TN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1569 IF (ITASK .NE. 4 .AND. ITASK .NE. 5) GO TO 420
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1570 IF (IHIT) T = TCRIT
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1571 420 ISTATE = 2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1572 RWORK(11) = HU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1573 RWORK(12) = H
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1574 RWORK(13) = TN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1575 IWORK(11) = NST
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1576 IWORK(12) = NFE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1577 IWORK(13) = NJE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1578 IWORK(14) = NQU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1579 IWORK(15) = NQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1580 RETURN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1581 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1582 C Block H.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1583 C The following block handles all unsuccessful returns other than
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1584 C those for illegal input. First the error message routine is called.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1585 C If there was an error test or convergence test failure, IMXER is set.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1586 C Then Y is loaded from YH and T is set to TN. The optional outputs
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1587 C are loaded into the work arrays before returning.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1588 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1589 C The maximum number of steps was taken before reaching TOUT. ----------
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1590 500 CALL XERRWD('SLSODE- At current T (=R1), MXSTEP (=I1) steps ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1591 1 50, 201, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1592 CALL XERRWD(' taken on this call before reaching TOUT ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1593 1 50, 201, 0, 1, MXSTEP, 0, 1, TN, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1594 ISTATE = -1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1595 GO TO 580
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1596 C EWT(I) .LE. 0.0 for some I (not at start of problem). ----------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1597 510 EWTI = RWORK(LEWT+I-1)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1598 CALL XERRWD('SLSODE- At T (=R1), EWT(I1) has become R2 .LE. 0.',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1599 1 50, 202, 0, 1, I, 0, 2, TN, EWTI)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1600 ISTATE = -6
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1601 GO TO 580
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1602 C Too much accuracy requested for machine precision. -------------------
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1603 520 CALL XERRWD('SLSODE- At T (=R1), too much accuracy requested ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1604 1 50, 203, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1605 CALL XERRWD(' for precision of machine.. see TOLSF (=R2) ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1606 1 50, 203, 0, 0, 0, 0, 2, TN, TOLSF)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1607 RWORK(14) = TOLSF
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1608 ISTATE = -2
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1609 GO TO 580
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1610 C KFLAG = -1. Error test failed repeatedly or with ABS(H) = HMIN. -----
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1611 530 CALL XERRWD('SLSODE- At T(=R1) and step size H(=R2), the error',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1612 1 50, 204, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1613 CALL XERRWD(' test failed repeatedly or with ABS(H) = HMIN',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1614 1 50, 204, 0, 0, 0, 0, 2, TN, H)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1615 ISTATE = -4
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1616 GO TO 560
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1617 C KFLAG = -2. Convergence failed repeatedly or with ABS(H) = HMIN. ----
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1618 540 CALL XERRWD('SLSODE- At T (=R1) and step size H (=R2), the ',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1619 1 50, 205, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1620 CALL XERRWD(' corrector convergence failed repeatedly ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1621 1 50, 205, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1622 CALL XERRWD(' or with ABS(H) = HMIN ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1623 1 30, 205, 0, 0, 0, 0, 2, TN, H)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1624 ISTATE = -5
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1625 C Compute IMXER if relevant. -------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1626 560 BIG = 0.0E0
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1627 IMXER = 1
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1628 DO 570 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1629 SIZE = ABS(RWORK(I+LACOR-1)*RWORK(I+LEWT-1))
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1630 IF (BIG .GE. SIZE) GO TO 570
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1631 BIG = SIZE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1632 IMXER = I
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1633 570 CONTINUE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1634 IWORK(16) = IMXER
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1635 C Set Y vector, T, and optional outputs. -------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1636 580 DO 590 I = 1,N
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1637 590 Y(I) = RWORK(I+LYH-1)
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1638 T = TN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1639 RWORK(11) = HU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1640 RWORK(12) = H
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1641 RWORK(13) = TN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1642 IWORK(11) = NST
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1643 IWORK(12) = NFE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1644 IWORK(13) = NJE
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1645 IWORK(14) = NQU
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1646 IWORK(15) = NQ
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1647 RETURN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1648 C-----------------------------------------------------------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1649 C Block I.
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1650 C The following block handles all error returns due to illegal input
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1651 C (ISTATE = -3), as detected before calling the core integrator.
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1652 C First the error message routine is called. If the illegal input
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1653 C is a negative ISTATE, the run is aborted (apparent infinite loop).
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1654 C-----------------------------------------------------------------------
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1655 601 CALL XERRWD('SLSODE- ISTATE (=I1) illegal ',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1656 1 30, 1, 0, 1, ISTATE, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1657 IF (ISTATE .LT. 0) GO TO 800
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1658 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1659 602 CALL XERRWD('SLSODE- ITASK (=I1) illegal ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1660 1 30, 2, 0, 1, ITASK, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1661 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1662 603 CALL XERRWD('SLSODE- ISTATE .GT. 1 but SLSODE not initialized ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1663 1 50, 3, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1664 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1665 604 CALL XERRWD('SLSODE- NEQ (=I1) .LT. 1 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1666 1 30, 4, 0, 1, NEQ(1), 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1667 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1668 605 CALL XERRWD('SLSODE- ISTATE = 3 and NEQ increased (I1 to I2) ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1669 1 50, 5, 0, 2, N, NEQ(1), 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1670 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1671 606 CALL XERRWD('SLSODE- ITOL (=I1) illegal ',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1672 1 30, 6, 0, 1, ITOL, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1673 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1674 607 CALL XERRWD('SLSODE- IOPT (=I1) illegal ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1675 1 30, 7, 0, 1, IOPT, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1676 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1677 608 CALL XERRWD('SLSODE- MF (=I1) illegal ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1678 1 30, 8, 0, 1, MF, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1679 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1680 609 CALL XERRWD('SLSODE- ML (=I1) illegal.. .LT.0 or .GE.NEQ (=I2)',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1681 1 50, 9, 0, 2, ML, NEQ(1), 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1682 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1683 610 CALL XERRWD('SLSODE- MU (=I1) illegal.. .LT.0 or .GE.NEQ (=I2)',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1684 1 50, 10, 0, 2, MU, NEQ(1), 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1685 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1686 611 CALL XERRWD('SLSODE- MAXORD (=I1) .LT. 0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1687 1 30, 11, 0, 1, MAXORD, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1688 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1689 612 CALL XERRWD('SLSODE- MXSTEP (=I1) .LT. 0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1690 1 30, 12, 0, 1, MXSTEP, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1691 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1692 613 CALL XERRWD('SLSODE- MXHNIL (=I1) .LT. 0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1693 1 30, 13, 0, 1, MXHNIL, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1694 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1695 614 CALL XERRWD('SLSODE- TOUT (=R1) behind T (=R2) ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1696 1 40, 14, 0, 0, 0, 0, 2, TOUT, T)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1697 CALL XERRWD(' Integration direction is given by H0 (=R1) ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1698 1 50, 14, 0, 0, 0, 0, 1, H0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1699 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1700 615 CALL XERRWD('SLSODE- HMAX (=R1) .LT. 0.0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1701 1 30, 15, 0, 0, 0, 0, 1, HMAX, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1702 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1703 616 CALL XERRWD('SLSODE- HMIN (=R1) .LT. 0.0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1704 1 30, 16, 0, 0, 0, 0, 1, HMIN, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1705 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1706 617 CALL XERRWD(
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1707 1 'SLSODE- RWORK length needed, LENRW (=I1), exceeds LRW (=I2)',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1708 1 60, 17, 0, 2, LENRW, LRW, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1709 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1710 618 CALL XERRWD(
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1711 1 'SLSODE- IWORK length needed, LENIW (=I1), exceeds LIW (=I2)',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1712 1 60, 18, 0, 2, LENIW, LIW, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1713 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1714 619 CALL XERRWD('SLSODE- RTOL(I1) is R1 .LT. 0.0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1715 1 40, 19, 0, 1, I, 0, 1, RTOLI, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1716 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1717 620 CALL XERRWD('SLSODE- ATOL(I1) is R1 .LT. 0.0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1718 1 40, 20, 0, 1, I, 0, 1, ATOLI, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1719 GO TO 700
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1720 621 EWTI = RWORK(LEWT+I-1)
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1721 CALL XERRWD('SLSODE- EWT(I1) is R1 .LE. 0.0 ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1722 1 40, 21, 0, 1, I, 0, 1, EWTI, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1723 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1724 622 CALL XERRWD(
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1725 1 'SLSODE- TOUT (=R1) too close to T(=R2) to start integration',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1726 1 60, 22, 0, 0, 0, 0, 2, TOUT, T)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1727 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1728 623 CALL XERRWD(
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1729 1 'SLSODE- ITASK = I1 and TOUT (=R1) behind TCUR - HU (= R2) ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1730 1 60, 23, 0, 1, ITASK, 0, 2, TOUT, TP)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1731 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1732 624 CALL XERRWD(
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1733 1 'SLSODE- ITASK = 4 OR 5 and TCRIT (=R1) behind TCUR (=R2) ',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1734 1 60, 24, 0, 0, 0, 0, 2, TCRIT, TN)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1735 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1736 625 CALL XERRWD(
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1737 1 'SLSODE- ITASK = 4 or 5 and TCRIT (=R1) behind TOUT (=R2) ',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1738 1 60, 25, 0, 0, 0, 0, 2, TCRIT, TOUT)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1739 GO TO 700
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1740 626 CALL XERRWD('SLSODE- At start of problem, too much accuracy ',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1741 1 50, 26, 0, 0, 0, 0, 0, 0.0E0, 0.0E0)
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1742 CALL XERRWD(
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1743 1 ' requested for precision of machine.. See TOLSF (=R1) ',
2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1744 1 60, 26, 0, 0, 0, 0, 1, TOLSF, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1745 RWORK(14) = TOLSF
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1746 GO TO 700
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1747 627 CALL XERRWD('SLSODE- Trouble in SINTDY. ITASK = I1, TOUT = R1',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1748 1 50, 27, 0, 1, ITASK, 0, 1, TOUT, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1749 C
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1750 700 ISTATE = -3
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1751 RETURN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1752 C
19627 446c46af4b42 strip trailing whitespace from most source files John W. Eaton <jwe@octave.org> parents: 15271 diff changeset	1753 800 CALL XERRWD('SLSODE- Run aborted.. apparent infinite loop ',
7794 2b458dfe31ae Replace use of xerrwv with xerrwd and rumach with d1mach(4) in newly imported code David Bateman <dbateman@free.fr> parents: 7793 diff changeset	1754 1 50, 303, 2, 0, 0, 0, 0, 0.0E0, 0.0E0)
7793 96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1755 RETURN
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1756 C----------------------- END OF SUBROUTINE SLSODE ----------------------
96ba591be50f Add some more support for single precision to libcruft functions David Bateman <dbateman@free.fr> parents: diff changeset	1757 END

Mercurial > octave-nkf

annotate liboctave/cruft/odepack/slsode.f @ 19627:446c46af4b42 stable