Remove amos and Faddeeva - they are now in openspecfun

Faddeeva/Faddeeva.c

@@ -1,3 +0,0 @@
-/* The Faddeeva.cc file contains macros to let it compile as C code
-   (assuming C99 complex-number support), so just #include it. */
-#include "Faddeeva.cc"

Faddeeva/Faddeeva.cc

@@ -1,2524 +0,0 @@
-//  -*- mode:c++; tab-width:2; indent-tabs-mode:nil;  -*-
-
-/* Copyright (c) 2012 Massachusetts Institute of Technology
- * 
- * Permission is hereby granted, free of charge, to any person obtaining
- * a copy of this software and associated documentation files (the
- * "Software"), to deal in the Software without restriction, including
- * without limitation the rights to use, copy, modify, merge, publish,
- * distribute, sublicense, and/or sell copies of the Software, and to
- * permit persons to whom the Software is furnished to do so, subject to
- * the following conditions:
- * 
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- * 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
- * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
- * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
- * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 
- */
-
-/* (Note that this file can be compiled with either C++, in which
-    case it uses C++ std::complex<double>, or C, in which case it
-    uses C99 double complex.) */
-
-/* Available at: http://ab-initio.mit.edu/Faddeeva
-
-   Computes various error functions (erf, erfc, erfi, erfcx), 
-   including the Dawson integral, in the complex plane, based
-   on algorithms for the computation of the Faddeeva function 
-              w(z) = exp(-z^2) * erfc(-i*z).
-   Given w(z), the error functions are mostly straightforward
-   to compute, except for certain regions where we have to
-   switch to Taylor expansions to avoid cancellation errors
-   [e.g. near the origin for erf(z)].
-
-   To compute the Faddeeva function, we use a combination of two
-   algorithms:
-
-   For sufficiently large |z|, we use a continued-fraction expansion
-   for w(z) similar to those described in:
-
-      Walter Gautschi, "Efficient computation of the complex error
-      function," SIAM J. Numer. Anal. 7(1), pp. 187-198 (1970)
-
-      G. P. M. Poppe and C. M. J. Wijers, "More efficient computation
-      of the complex error function," ACM Trans. Math. Soft. 16(1),
-      pp. 38-46 (1990).
-
-   Unlike those papers, however, we switch to a completely different
-   algorithm for smaller |z|:
-
-      Mofreh R. Zaghloul and Ahmed N. Ali, "Algorithm 916: Computing the
-      Faddeyeva and Voigt Functions," ACM Trans. Math. Soft. 38(2), 15
-      (2011).
-
-   (I initially used this algorithm for all z, but it turned out to be
-    significantly slower than the continued-fraction expansion for
-    larger |z|.  On the other hand, it is competitive for smaller |z|, 
-    and is significantly more accurate than the Poppe & Wijers code
-    in some regions, e.g. in the vicinity of z=1+1i.)
-
-   Note that this is an INDEPENDENT RE-IMPLEMENTATION of these algorithms,
-   based on the description in the papers ONLY.  In particular, I did
-   not refer to the authors' Fortran or Matlab implementations, respectively,
-   (which are under restrictive ACM copyright terms and therefore unusable
-    in free/open-source software).
-
-   Steven G. Johnson, Massachusetts Institute of Technology
-   http://math.mit.edu/~stevenj
-   October 2012.
-
-    -- Note that Algorithm 916 assumes that the erfc(x) function, 
-       or rather the scaled function erfcx(x) = exp(x*x)*erfc(x),
-       is supplied for REAL arguments x.   I originally used an
-       erfcx routine derived from DERFC in SLATEC, but I have
-       since replaced it with a much faster routine written by
-       me which uses a combination of continued-fraction expansions
-       and a lookup table of Chebyshev polynomials.  For speed,
-       I implemented a similar algorithm for Im[w(x)] of real x,
-       since this comes up frequently in the other error functions.
-
-   A small test program is included the end, which checks
-   the w(z) etc. results against several known values.  To compile
-   the test function, compile with -DTEST_FADDEEVA (that is,
-   #define TEST_FADDEEVA).
-
-   If HAVE_CONFIG_H is #defined (e.g. by compiling with -DHAVE_CONFIG_H),
-   then we #include "config.h", which is assumed to be a GNU autoconf-style
-   header defining HAVE_* macros to indicate the presence of features. In
-   particular, if HAVE_ISNAN and HAVE_ISINF are #defined, we use those
-   functions in math.h instead of defining our own, and if HAVE_ERF and/or
-   HAVE_ERFC are defined we use those functions from <cmath> for erf and
-   erfc of real arguments, respectively, instead of defining our own.
-
-   REVISION HISTORY:
-       4 October 2012: Initial public release (SGJ)
-       5 October 2012: Revised (SGJ) to fix spelling error,
-                       start summation for large x at round(x/a) (> 1)
-                       rather than ceil(x/a) as in the original
-                       paper, which should slightly improve performance
-                       (and, apparently, slightly improves accuracy)
-      19 October 2012: Revised (SGJ) to fix bugs for large x, large -y,
-                       and 15<x<26. Performance improvements. Prototype
-                       now supplies default value for relerr.
-      24 October 2012: Switch to continued-fraction expansion for
-                       sufficiently large z, for performance reasons.
-                       Also, avoid spurious overflow for |z| > 1e154.
-                       Set relerr argument to min(relerr,0.1).
-      27 October 2012: Enhance accuracy in Re[w(z)] taken by itself,
-                       by switching to Alg. 916 in a region near
-                       the real-z axis where continued fractions
-                       have poor relative accuracy in Re[w(z)].  Thanks
-                       to M. Zaghloul for the tip.
-      29 October 2012: Replace SLATEC-derived erfcx routine with
-                       completely rewritten code by me, using a very
-                       different algorithm which is much faster.
-      30 October 2012: Implemented special-case code for real z
-                       (where real part is exp(-x^2) and imag part is
-                        Dawson integral), using algorithm similar to erfx.
-                       Export ImFaddeeva_w function to make Dawson's
-                       integral directly accessible.
-      3 November 2012: Provide implementations of erf, erfc, erfcx,
-                       and Dawson functions in Faddeeva:: namespace,
-                       in addition to Faddeeva::w.  Provide header
-                       file Faddeeva.hh.
-      4 November 2012: Slightly faster erf for real arguments.
-                       Updated MATLAB and Octave plugins.
-     27 November 2012: Support compilation with either C++ or
-                       plain C (using C99 complex numbers).
-                       For real x, use standard-library erf(x)
-                       and erfc(x) if available (for C99 or C++11).
-                       #include "config.h" if HAVE_CONFIG_H is #defined.
-     15 December 2012: Portability fixes (copysign, Inf/NaN creation),
-                       use CMPLX/__builtin_complex if available in C,
-                       slight accuracy improvements to erf and dawson
-                       functions near the origin.  Use gnulib functions
-                       if GNULIB_NAMESPACE is defined.
-     18 December 2012: Slight tweaks (remove recomputation of x*x in Dawson)
-*/
-
-/////////////////////////////////////////////////////////////////////////
-/* If this file is compiled as a part of a larger project,
-   support using an autoconf-style config.h header file
-   (with various "HAVE_*" #defines to indicate features)
-   if HAVE_CONFIG_H is #defined (in GNU autotools style). */
-
-#ifdef HAVE_CONFIG_H
-#  include "config.h"
-#endif
-
-/////////////////////////////////////////////////////////////////////////
-// macros to allow us to use either C++ or C (with C99 features)
-
-#ifdef __cplusplus
-
-#  include "Faddeeva.hh"
-
-#  include <cfloat>
-#  include <cmath>
-#  include <limits>
-using namespace std;
-
-// use std::numeric_limits, since 1./0. and 0./0. fail with some compilers (MS)
-#  define Inf numeric_limits<double>::infinity()
-#  define NaN numeric_limits<double>::quiet_NaN()
-
-typedef complex<double> cmplx;
-
-// Use C-like complex syntax, since the C syntax is more restrictive
-#  define cexp(z) exp(z)
-#  define creal(z) real(z)
-#  define cimag(z) imag(z)
-#  define cpolar(r,t) polar(r,t)
-
-#  define C(a,b) cmplx(a,b)
-
-#  define FADDEEVA(name) Faddeeva::name
-#  define FADDEEVA_RE(name) Faddeeva::name
-
-// isnan/isinf were introduced in C++11
-#  if (__cplusplus < 201103L) && (!defined(HAVE_ISNAN) || !defined(HAVE_ISINF))
-static inline bool my_isnan(double x) { return x != x; }
-#    define isnan my_isnan
-static inline bool my_isinf(double x) { return 1/x == 0.; }
-#    define isinf my_isinf
-#  elif (__cplusplus >= 201103L)
-// g++ gets confused between the C and C++ isnan/isinf functions
-#    define isnan std::isnan
-#    define isinf std::isinf
-#  endif
-
-// copysign was introduced in C++11 (and is also in POSIX and C99)
-#  if defined(_WIN32) || defined(__WIN32__)
-#    define copysign _copysign // of course MS had to be different
-#  elif defined(GNULIB_NAMESPACE) // we are using using gnulib <cmath>
-#    define copysign GNULIB_NAMESPACE::copysign
-#  elif (__cplusplus < 201103L) && !defined(HAVE_COPYSIGN) && !defined(__linux__) && !(defined(__APPLE__) && defined(__MACH__)) && !defined(_AIX)
-static inline double my_copysign(double x, double y) { return y<0 ? -x : x; }
-#    define copysign my_copysign
-#  endif
-
-// If we are using the gnulib <cmath> (e.g. in the GNU Octave sources),
-// gnulib generates a link warning if we use ::floor instead of gnulib::floor.
-// This warning is completely innocuous because the only difference between
-// gnulib::floor and the system ::floor (and only on ancient OSF systems)
-// has to do with floor(-0), which doesn't occur in the usage below, but
-// the Octave developers prefer that we silence the warning.
-#  ifdef GNULIB_NAMESPACE
-#    define floor GNULIB_NAMESPACE::floor
-#  endif
-
-#else // !__cplusplus, i.e. pure C (requires C99 features)
-
-#  include "Faddeeva.h"
-
-#  define _GNU_SOURCE // enable GNU libc NAN extension if possible
-
-#  include <float.h>
-
-// CHANGED for OPENLIBM:
-#  include <openlibm.h>
-
-typedef double complex cmplx;
-
-#  define FADDEEVA(name) Faddeeva_ ## name
-#  define FADDEEVA_RE(name) Faddeeva_ ## name ## _re
-
-/* Constructing complex numbers like 0+i*NaN is problematic in C99
-   without the C11 CMPLX macro, because 0.+I*NAN may give NaN+i*NAN if
-   I is a complex (rather than imaginary) constant.  For some reason,
-   however, it works fine in (pre-4.7) gcc if I define Inf and NaN as
-   1/0 and 0/0 (and only if I compile with optimization -O1 or more),
-   but not if I use the INFINITY or NAN macros. */
-
-/* __builtin_complex was introduced in gcc 4.7, but the C11 CMPLX macro
-   may not be defined unless we are using a recent (2012) version of
-   glibc and compile with -std=c11... note that icc lies about being
-   gcc and probably doesn't have this builtin(?), so exclude icc explicitly */
-#  if !defined(CMPLX) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7)) && !(defined(__ICC) || defined(__INTEL_COMPILER))
-#    define CMPLX(a,b) __builtin_complex((double) (a), (double) (b))
-#  endif
-
-// CHANGED for OPENLIBM:
-#  ifndef CMPLX
-#    include "math_private.h"
-#    define CMPLX(a,b) cpack(a,b)
-#  endif
-
-#  ifdef CMPLX // C11
-#    define C(a,b) CMPLX(a,b)
-#    define Inf INFINITY // C99 infinity
-#    ifdef NAN // GNU libc extension
-#      define NaN NAN
-#    else
-#      define NaN (0./0.) // NaN
-#    endif
-#  else
-#    define C(a,b) ((a) + I*(b))
-#    define Inf (1./0.) 
-#    define NaN (0./0.) 
-#  endif
-
-static inline cmplx cpolar(double r, double t)
-{
-  if (r == 0.0 && !isnan(t))
-    return 0.0;
-  else
-    return C(r * cos(t), r * sin(t));
-}
-
-#endif // !__cplusplus, i.e. pure C (requires C99 features)
-
-/////////////////////////////////////////////////////////////////////////
-// Auxiliary routines to compute other special functions based on w(z)
-
-// compute erfcx(z) = exp(z^2) erfz(z)
-cmplx FADDEEVA(erfcx)(cmplx z, double relerr)
-{
-  return FADDEEVA(w)(C(-cimag(z), creal(z)), relerr);
-}
-
-// compute the error function erf(x)
-double FADDEEVA_RE(erf)(double x)
-{
-#if !defined(__cplusplus)
-  return erf(x); // C99 supplies erf in math.h
-#elif (__cplusplus >= 201103L) || defined(HAVE_ERF)
-  return ::erf(x); // C++11 supplies std::erf in cmath
-#else
-  double mx2 = -x*x;
-  if (mx2 < -750) // underflow
-    return (x >= 0 ? 1.0 : -1.0);
-
-  if (x >= 0) {
-    if (x < 8e-2) goto taylor;
-    return 1.0 - exp(mx2) * FADDEEVA_RE(erfcx)(x);
-  }
-  else { // x < 0
-    if (x > -8e-2) goto taylor;
-    return exp(mx2) * FADDEEVA_RE(erfcx)(-x) - 1.0;
-  }
-
-  // Use Taylor series for small |x|, to avoid cancellation inaccuracy
-  //   erf(x) = 2/sqrt(pi) * x * (1 - x^2/3 + x^4/10 - x^6/42 + x^8/216 + ...)
- taylor:
-  return x * (1.1283791670955125739
-              + mx2 * (0.37612638903183752464
-                       + mx2 * (0.11283791670955125739
-                                + mx2 * (0.026866170645131251760
-                                         + mx2 * 0.0052239776254421878422))));
-#endif
-}
-
-// compute the error function erf(z)
-cmplx FADDEEVA(erf)(cmplx z, double relerr)
-{
-  double x = creal(z), y = cimag(z);
-
-  if (y == 0)
-    return C(FADDEEVA_RE(erf)(x),
-             y); // preserve sign of 0
-  if (x == 0) // handle separately for speed & handling of y = Inf or NaN
-    return C(x, // preserve sign of 0
-             /* handle y -> Inf limit manually, since
-                exp(y^2) -> Inf but Im[w(y)] -> 0, so
-                IEEE will give us a NaN when it should be Inf */
-             y*y > 720 ? (y > 0 ? Inf : -Inf)
-             : exp(y*y) * FADDEEVA(w_im)(y));
-  
-  double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow
-  double mIm_z2 = -2*x*y; // Im(-z^2)
-  if (mRe_z2 < -750) // underflow
-    return (x >= 0 ? 1.0 : -1.0);
-
-  /* Handle positive and negative x via different formulas,
-     using the mirror symmetries of w, to avoid overflow/underflow
-     problems from multiplying exponentially large and small quantities. */
-  if (x >= 0) {
-    if (x < 8e-2) {
-      if (fabs(y) < 1e-2)
-        goto taylor;
-      else if (fabs(mIm_z2) < 5e-3 && x < 5e-3)
-        goto taylor_erfi;
-    }
-    /* don't use complex exp function, since that will produce spurious NaN
-       values when multiplying w in an overflow situation. */
-    return 1.0 - exp(mRe_z2) *
-      (C(cos(mIm_z2), sin(mIm_z2))
-       * FADDEEVA(w)(C(-y,x), relerr));
-  }
-  else { // x < 0
-    if (x > -8e-2) { // duplicate from above to avoid fabs(x) call
-      if (fabs(y) < 1e-2)
-        goto taylor;
-      else if (fabs(mIm_z2) < 5e-3 && x > -5e-3)
-        goto taylor_erfi;
-    }
-    else if (isnan(x))
-      return C(NaN, y == 0 ? 0 : NaN);
-    /* don't use complex exp function, since that will produce spurious NaN
-       values when multiplying w in an overflow situation. */
-    return exp(mRe_z2) *
-      (C(cos(mIm_z2), sin(mIm_z2))
-       * FADDEEVA(w)(C(y,-x), relerr)) - 1.0;
-  }
-
-  // Use Taylor series for small |z|, to avoid cancellation inaccuracy
-  //   erf(z) = 2/sqrt(pi) * z * (1 - z^2/3 + z^4/10 - z^6/42 + z^8/216 + ...)
- taylor:
-  {
-    cmplx mz2 = C(mRe_z2, mIm_z2); // -z^2
-    return z * (1.1283791670955125739
-                + mz2 * (0.37612638903183752464
-                         + mz2 * (0.11283791670955125739
-                                  + mz2 * (0.026866170645131251760
-                                          + mz2 * 0.0052239776254421878422))));
-  }
-
-  /* for small |x| and small |xy|, 
-     use Taylor series to avoid cancellation inaccuracy:
-       erf(x+iy) = erf(iy)
-          + 2*exp(y^2)/sqrt(pi) *
-            [ x * (1 - x^2 * (1+2y^2)/3 + x^4 * (3+12y^2+4y^4)/30 + ... 
-              - i * x^2 * y * (1 - x^2 * (3+2y^2)/6 + ...) ]
-     where:
-        erf(iy) = exp(y^2) * Im[w(y)]
-  */
- taylor_erfi:
-  {
-    double x2 = x*x, y2 = y*y;
-    double expy2 = exp(y2);
-    return C
-      (expy2 * x * (1.1283791670955125739
-                    - x2 * (0.37612638903183752464
-                            + 0.75225277806367504925*y2)
-                    + x2*x2 * (0.11283791670955125739
-                               + y2 * (0.45135166683820502956
-                                       + 0.15045055561273500986*y2))),
-       expy2 * (FADDEEVA(w_im)(y)
-                - x2*y * (1.1283791670955125739 
-                          - x2 * (0.56418958354775628695 
-                                  + 0.37612638903183752464*y2))));
-  }
-}
-
-// erfi(z) = -i erf(iz)
-cmplx FADDEEVA(erfi)(cmplx z, double relerr)
-{
-  cmplx e = FADDEEVA(erf)(C(-cimag(z),creal(z)), relerr);
-  return C(cimag(e), -creal(e));
-}
-
-// erfi(x) = -i erf(ix)
-double FADDEEVA_RE(erfi)(double x)
-{
-  return x*x > 720 ? (x > 0 ? Inf : -Inf)
-    : exp(x*x) * FADDEEVA(w_im)(x);
-}
-
-// erfc(x) = 1 - erf(x)
-double FADDEEVA_RE(erfc)(double x)
-{
-#if !defined(__cplusplus)
-  return erfc(x); // C99 supplies erfc in math.h
-#elif (__cplusplus >= 201103L) || defined(HAVE_ERFC)
-  return ::erfc(x); // C++11 supplies std::erfc in cmath
-#else
-  if (x*x > 750) // underflow
-    return (x >= 0 ? 0.0 : 2.0);
-  return x >= 0 ? exp(-x*x) * FADDEEVA_RE(erfcx)(x) 
-    : 2. - exp(-x*x) * FADDEEVA_RE(erfcx)(-x);
-#endif
-}
-
-// erfc(z) = 1 - erf(z)
-cmplx FADDEEVA(erfc)(cmplx z, double relerr)
-{
-  double x = creal(z), y = cimag(z);
-
-  if (x == 0.)
-    return C(1,
-             /* handle y -> Inf limit manually, since
-                exp(y^2) -> Inf but Im[w(y)] -> 0, so
-                IEEE will give us a NaN when it should be Inf */
-             y*y > 720 ? (y > 0 ? -Inf : Inf)
-             : -exp(y*y) * FADDEEVA(w_im)(y));
-  if (y == 0.) {
-    if (x*x > 750) // underflow
-      return C(x >= 0 ? 0.0 : 2.0,
-               -y); // preserve sign of 0
-    return C(x >= 0 ? exp(-x*x) * FADDEEVA_RE(erfcx)(x) 
-             : 2. - exp(-x*x) * FADDEEVA_RE(erfcx)(-x),
-             -y); // preserve sign of zero
-  }
-
-  double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow
-  double mIm_z2 = -2*x*y; // Im(-z^2)
-  if (mRe_z2 < -750) // underflow
-    return (x >= 0 ? 0.0 : 2.0);
-
-  if (x >= 0)
-    return cexp(C(mRe_z2, mIm_z2))
-      * FADDEEVA(w)(C(-y,x), relerr);
-  else
-    return 2.0 - cexp(C(mRe_z2, mIm_z2))
-      * FADDEEVA(w)(C(y,-x), relerr);
-}
-
-// compute Dawson(x) = sqrt(pi)/2  *  exp(-x^2) * erfi(x)
-double FADDEEVA_RE(Dawson)(double x)
-{
-  const double spi2 = 0.8862269254527580136490837416705725913990; // sqrt(pi)/2
-  return spi2 * FADDEEVA(w_im)(x);
-}
-
-// compute Dawson(z) = sqrt(pi)/2  *  exp(-z^2) * erfi(z)
-cmplx FADDEEVA(Dawson)(cmplx z, double relerr)
-{
-  const double spi2 = 0.8862269254527580136490837416705725913990; // sqrt(pi)/2
-  double x = creal(z), y = cimag(z);
-
-  // handle axes separately for speed & proper handling of x or y = Inf or NaN
-  if (y == 0)
-    return C(spi2 * FADDEEVA(w_im)(x),
-             -y); // preserve sign of 0
-  if (x == 0) {
-    double y2 = y*y;
-    if (y2 < 2.5e-5) { // Taylor expansion
-      return C(x, // preserve sign of 0
-               y * (1.
-                    + y2 * (0.6666666666666666666666666666666666666667
-                            + y2 * 0.26666666666666666666666666666666666667)));
-    }
-    return C(x, // preserve sign of 0
-             spi2 * (y >= 0 
-                     ? exp(y2) - FADDEEVA_RE(erfcx)(y)
-                     : FADDEEVA_RE(erfcx)(-y) - exp(y2)));
-  }
-
-  double mRe_z2 = (y - x) * (x + y); // Re(-z^2), being careful of overflow
-  double mIm_z2 = -2*x*y; // Im(-z^2)
-  cmplx mz2 = C(mRe_z2, mIm_z2); // -z^2
-
-  /* Handle positive and negative x via different formulas,
-     using the mirror symmetries of w, to avoid overflow/underflow
-     problems from multiplying exponentially large and small quantities. */
-  if (y >= 0) {
-    if (y < 5e-3) {
-      if (fabs(x) < 5e-3)
-        goto taylor;
-      else if (fabs(mIm_z2) < 5e-3)
-        goto taylor_realaxis;
-    }
-    cmplx res = cexp(mz2) - FADDEEVA(w)(z, relerr);
-    return spi2 * C(-cimag(res), creal(res));
-  }
-  else { // y < 0
-    if (y > -5e-3) { // duplicate from above to avoid fabs(x) call
-      if (fabs(x) < 5e-3)
-        goto taylor;
-      else if (fabs(mIm_z2) < 5e-3)
-        goto taylor_realaxis;
-    }
-    else if (isnan(y))
-      return C(x == 0 ? 0 : NaN, NaN);
-    cmplx res = FADDEEVA(w)(-z, relerr) - cexp(mz2);
-    return spi2 * C(-cimag(res), creal(res));
-  }
-
-  // Use Taylor series for small |z|, to avoid cancellation inaccuracy
-  //     dawson(z) = z - 2/3 z^3 + 4/15 z^5 + ...
- taylor:
-  return z * (1.
-              + mz2 * (0.6666666666666666666666666666666666666667
-                       + mz2 * 0.2666666666666666666666666666666666666667));
-
-  /* for small |y| and small |xy|, 
-     use Taylor series to avoid cancellation inaccuracy:
-       dawson(x + iy)
-        = D + y^2 (D + x - 2Dx^2)
-            + y^4 (D/2 + 5x/6 - 2Dx^2 - x^3/3 + 2Dx^4/3)
-        + iy [ (1-2Dx) + 2/3 y^2 (1 - 3Dx - x^2 + 2Dx^3)
-              + y^4/15 (4 - 15Dx - 9x^2 + 20Dx^3 + 2x^4 - 4Dx^5) ] + ...
-     where D = dawson(x) 
-
-     However, for large |x|, 2Dx -> 1 which gives cancellation problems in
-     this series (many of the leading terms cancel).  So, for large |x|,
-     we need to substitute a continued-fraction expansion for D.
-
-        dawson(x) = 0.5 / (x-0.5/(x-1/(x-1.5/(x-2/(x-2.5/(x...))))))
-
-     The 6 terms shown here seems to be the minimum needed to be
-     accurate as soon as the simpler Taylor expansion above starts
-     breaking down.  Using this 6-term expansion, factoring out the
-     denominator, and simplifying with Maple, we obtain:
-
-      Re dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / x
-        = 33 - 28x^2 + 4x^4 + y^2 (18 - 4x^2) + 4 y^4
-      Im dawson(x + iy) * (-15 + 90x^2 - 60x^4 + 8x^6) / y
-        = -15 + 24x^2 - 4x^4 + 2/3 y^2 (6x^2 - 15) - 4 y^4
-
-     Finally, for |x| > 5e7, we can use a simpler 1-term continued-fraction
-     expansion for the real part, and a 2-term expansion for the imaginary
-     part.  (This avoids overflow problems for huge |x|.)  This yields:
-     
-     Re dawson(x + iy) = [1 + y^2 (1 + y^2/2 - (xy)^2/3)] / (2x)
-     Im dawson(x + iy) = y [ -1 - 2/3 y^2 + y^4/15 (2x^2 - 4) ] / (2x^2 - 1)
-
- */
- taylor_realaxis:
-  {
-    double x2 = x*x;
-    if (x2 > 1600) { // |x| > 40
-      double y2 = y*y;
-      if (x2 > 25e14) {// |x| > 5e7
-        double xy2 = (x*y)*(x*y);
-        return C((0.5 + y2 * (0.5 + 0.25*y2
-                              - 0.16666666666666666667*xy2)) / x,
-                 y * (-1 + y2 * (-0.66666666666666666667
-                                 + 0.13333333333333333333*xy2
-                                 - 0.26666666666666666667*y2))
-                 / (2*x2 - 1));
-      }
-      return (1. / (-15 + x2*(90 + x2*(-60 + 8*x2)))) *
-        C(x * (33 + x2 * (-28 + 4*x2)
-               + y2 * (18 - 4*x2 + 4*y2)),
-          y * (-15 + x2 * (24 - 4*x2)
-               + y2 * (4*x2 - 10 - 4*y2)));
-    }
-    else {
-      double D = spi2 * FADDEEVA(w_im)(x);
-      double y2 = y*y;
-      return C
-        (D + y2 * (D + x - 2*D*x2)
-         + y2*y2 * (D * (0.5 - x2 * (2 - 0.66666666666666666667*x2))
-                    + x * (0.83333333333333333333
-                           - 0.33333333333333333333 * x2)),
-         y * (1 - 2*D*x
-              + y2 * 0.66666666666666666667 * (1 - x2 - D*x * (3 - 2*x2))
-              + y2*y2 * (0.26666666666666666667 -
-                         x2 * (0.6 - 0.13333333333333333333 * x2)
-                         - D*x * (1 - x2 * (1.3333333333333333333
-                                            - 0.26666666666666666667 * x2)))));
-    }
-  }
-}
-
-/////////////////////////////////////////////////////////////////////////
-
-// return sinc(x) = sin(x)/x, given both x and sin(x) 
-// [since we only use this in cases where sin(x) has already been computed]
-static inline double sinc(double x, double sinx) { 
-  return fabs(x) < 1e-4 ? 1 - (0.1666666666666666666667)*x*x : sinx / x; 
-}
-
-// sinh(x) via Taylor series, accurate to machine precision for |x| < 1e-2
-static inline double sinh_taylor(double x) {
-  return x * (1 + (x*x) * (0.1666666666666666666667
-                           + 0.00833333333333333333333 * (x*x)));
-}
-
-static inline double sqr(double x) { return x*x; }
-
-// precomputed table of expa2n2[n-1] = exp(-a2*n*n)
-// for double-precision a2 = 0.26865... in FADDEEVA(w), below.
-static const double expa2n2[] = {
-  7.64405281671221563e-01,
-  3.41424527166548425e-01,
-  8.91072646929412548e-02,
-  1.35887299055460086e-02,
-  1.21085455253437481e-03,
-  6.30452613933449404e-05,
-  1.91805156577114683e-06,
-  3.40969447714832381e-08,
-  3.54175089099469393e-10,
-  2.14965079583260682e-12,
-  7.62368911833724354e-15,
-  1.57982797110681093e-17,
-  1.91294189103582677e-20,
-  1.35344656764205340e-23,
-  5.59535712428588720e-27,
-  1.35164257972401769e-30,
-  1.90784582843501167e-34,
-  1.57351920291442930e-38,
-  7.58312432328032845e-43,
-  2.13536275438697082e-47,
-  3.51352063787195769e-52,
-  3.37800830266396920e-57,
-  1.89769439468301000e-62,
-  6.22929926072668851e-68,
-  1.19481172006938722e-73,
-  1.33908181133005953e-79,
-  8.76924303483223939e-86,
-  3.35555576166254986e-92,
-  7.50264110688173024e-99,
-  9.80192200745410268e-106,
-  7.48265412822268959e-113,
-  3.33770122566809425e-120,
-  8.69934598159861140e-128,
-  1.32486951484088852e-135,
-  1.17898144201315253e-143,
-  6.13039120236180012e-152,
-  1.86258785950822098e-160,
-  3.30668408201432783e-169,
-  3.43017280887946235e-178,
-  2.07915397775808219e-187,
-  7.36384545323984966e-197,
-  1.52394760394085741e-206,
-  1.84281935046532100e-216,
-  1.30209553802992923e-226,
-  5.37588903521080531e-237,
-  1.29689584599763145e-247,
-  1.82813078022866562e-258,
-  1.50576355348684241e-269,
-  7.24692320799294194e-281,
-  2.03797051314726829e-292,
-  3.34880215927873807e-304,
-  0.0 // underflow (also prevents reads past array end, below)
-};
-
-/////////////////////////////////////////////////////////////////////////
-
-cmplx FADDEEVA(w)(cmplx z, double relerr)
-{
-  if (creal(z) == 0.0)
-    return C(FADDEEVA_RE(erfcx)(cimag(z)), 
-             creal(z)); // give correct sign of 0 in cimag(w)
-  else if (cimag(z) == 0)
-    return C(exp(-sqr(creal(z))),
-             FADDEEVA(w_im)(creal(z)));
-
-  double a, a2, c;
-  if (relerr <= DBL_EPSILON) {
-    relerr = DBL_EPSILON;
-    a = 0.518321480430085929872; // pi / sqrt(-log(eps*0.5))
-    c = 0.329973702884629072537; // (2/pi) * a;
-    a2 = 0.268657157075235951582; // a^2
-  }
-  else {
-    const double pi = 3.14159265358979323846264338327950288419716939937510582;
-    if (relerr > 0.1) relerr = 0.1; // not sensible to compute < 1 digit
-    a = pi / sqrt(-log(relerr*0.5));
-    c = (2/pi)*a;
-    a2 = a*a;
-  }
-  const double x = fabs(creal(z));
-  const double y = cimag(z), ya = fabs(y);
-
-  cmplx ret = 0.; // return value
-
-  double sum1 = 0, sum2 = 0, sum3 = 0, sum4 = 0, sum5 = 0;
-
-#define USE_CONTINUED_FRACTION 1 // 1 to use continued fraction for large |z|
-
-#if USE_CONTINUED_FRACTION
-  if (ya > 7 || (x > 6  // continued fraction is faster
-                 /* As pointed out by M. Zaghloul, the continued
-                    fraction seems to give a large relative error in
-                    Re w(z) for |x| ~ 6 and small |y|, so use
-                    algorithm 816 in this region: */
-                 && (ya > 0.1 || (x > 8 && ya > 1e-10) || x > 28))) {
-    
-    /* Poppe & Wijers suggest using a number of terms
-           nu = 3 + 1442 / (26*rho + 77)
-       where rho = sqrt((x/x0)^2 + (y/y0)^2) where x0=6.3, y0=4.4.
-       (They only use this expansion for rho >= 1, but rho a little less
-        than 1 seems okay too.)
-       Instead, I did my own fit to a slightly different function
-       that avoids the hypotenuse calculation, using NLopt to minimize
-       the sum of the squares of the errors in nu with the constraint
-       that the estimated nu be >= minimum nu to attain machine precision.
-       I also separate the regions where nu == 2 and nu == 1. */
-    const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
-    double xs = y < 0 ? -creal(z) : creal(z); // compute for -z if y < 0
-    if (x + ya > 4000) { // nu <= 2
-      if (x + ya > 1e7) { // nu == 1, w(z) = i/sqrt(pi) / z
-        // scale to avoid overflow
-        if (x > ya) {
-          double yax = ya / xs; 
-          double denom = ispi / (xs + yax*ya);
-          ret = C(denom*yax, denom);
-        }
-        else if (isinf(ya))
-          return ((isnan(x) || y < 0) 
-                  ? C(NaN,NaN) : C(0,0));
-        else {
-          double xya = xs / ya;
-          double denom = ispi / (xya*xs + ya);
-          ret = C(denom, denom*xya);
-        }
-      }
-      else { // nu == 2, w(z) = i/sqrt(pi) * z / (z*z - 0.5)
-        double dr = xs*xs - ya*ya - 0.5, di = 2*xs*ya;
-        double denom = ispi / (dr*dr + di*di);
-        ret = C(denom * (xs*di-ya*dr), denom * (xs*dr+ya*di));
-      }
-    }
-    else { // compute nu(z) estimate and do general continued fraction
-      const double c0=3.9, c1=11.398, c2=0.08254, c3=0.1421, c4=0.2023; // fit
-      double nu = floor(c0 + c1 / (c2*x + c3*ya + c4));
-      double wr = xs, wi = ya;
-      for (nu = 0.5 * (nu - 1); nu > 0.4; nu -= 0.5) {
-        // w <- z - nu/w:
-        double denom = nu / (wr*wr + wi*wi);
-        wr = xs - wr * denom;
-        wi = ya + wi * denom;
-      }
-      { // w(z) = i/sqrt(pi) / w:
-        double denom = ispi / (wr*wr + wi*wi);
-        ret = C(denom*wi, denom*wr);
-      }
-    }
-    if (y < 0) {
-      // use w(z) = 2.0*exp(-z*z) - w(-z), 
-      // but be careful of overflow in exp(-z*z) 
-      //                                = exp(-(xs*xs-ya*ya) -2*i*xs*ya) 
-      return 2.0*cexp(C((ya-xs)*(xs+ya), 2*xs*y)) - ret;
-    }
-    else
-      return ret;
-  }
-#else // !USE_CONTINUED_FRACTION
-  if (x + ya > 1e7) { // w(z) = i/sqrt(pi) / z, to machine precision
-    const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
-    double xs = y < 0 ? -creal(z) : creal(z); // compute for -z if y < 0
-    // scale to avoid overflow
-    if (x > ya) {
-      double yax = ya / xs; 
-      double denom = ispi / (xs + yax*ya);
-      ret = C(denom*yax, denom);
-    }
-    else {
-      double xya = xs / ya;
-      double denom = ispi / (xya*xs + ya);
-      ret = C(denom, denom*xya);
-    }
-    if (y < 0) {
-      // use w(z) = 2.0*exp(-z*z) - w(-z), 
-      // but be careful of overflow in exp(-z*z) 
-      //                                = exp(-(xs*xs-ya*ya) -2*i*xs*ya) 
-      return 2.0*cexp(C((ya-xs)*(xs+ya), 2*xs*y)) - ret;
-    }
-    else
-      return ret;
-  }
-#endif // !USE_CONTINUED_FRACTION 
-
-  /* Note: The test that seems to be suggested in the paper is x <
-     sqrt(-log(DBL_MIN)), about 26.6, since otherwise exp(-x^2)
-     underflows to zero and sum1,sum2,sum4 are zero.  However, long
-     before this occurs, the sum1,sum2,sum4 contributions are
-     negligible in double precision; I find that this happens for x >
-     about 6, for all y.  On the other hand, I find that the case
-     where we compute all of the sums is faster (at least with the
-     precomputed expa2n2 table) until about x=10.  Furthermore, if we
-     try to compute all of the sums for x > 20, I find that we
-     sometimes run into numerical problems because underflow/overflow
-     problems start to appear in the various coefficients of the sums,
-     below.  Therefore, we use x < 10 here. */
-  else if (x < 10) {
-    double prod2ax = 1, prodm2ax = 1;
-    double expx2;
-
-    if (isnan(y))
-      return C(y,y);
-    
-    /* Somewhat ugly copy-and-paste duplication here, but I see significant
-       speedups from using the special-case code with the precomputed
-       exponential, and the x < 5e-4 special case is needed for accuracy. */
-
-    if (relerr == DBL_EPSILON) { // use precomputed exp(-a2*(n*n)) table
-      if (x < 5e-4) { // compute sum4 and sum5 together as sum5-sum4
-        const double x2 = x*x;
-        expx2 = 1 - x2 * (1 - 0.5*x2); // exp(-x*x) via Taylor
-        // compute exp(2*a*x) and exp(-2*a*x) via Taylor, to double precision
-        const double ax2 = 1.036642960860171859744*x; // 2*a*x
-        const double exp2ax =
-          1 + ax2 * (1 + ax2 * (0.5 + 0.166666666666666666667*ax2));
-        const double expm2ax =
-          1 - ax2 * (1 - ax2 * (0.5 - 0.166666666666666666667*ax2));
-        for (int n = 1; 1; ++n) {
-          const double coef = expa2n2[n-1] * expx2 / (a2*(n*n) + y*y);
-          prod2ax *= exp2ax;
-          prodm2ax *= expm2ax;
-          sum1 += coef;
-          sum2 += coef * prodm2ax;
-          sum3 += coef * prod2ax;
-          
-          // really = sum5 - sum4
-          sum5 += coef * (2*a) * n * sinh_taylor((2*a)*n*x);
-          
-          // test convergence via sum3
-          if (coef * prod2ax < relerr * sum3) break;
-        }
-      }
-      else { // x > 5e-4, compute sum4 and sum5 separately
-        expx2 = exp(-x*x);
-        const double exp2ax = exp((2*a)*x), expm2ax = 1 / exp2ax;
-        for (int n = 1; 1; ++n) {
-          const double coef = expa2n2[n-1] * expx2 / (a2*(n*n) + y*y);
-          prod2ax *= exp2ax;
-          prodm2ax *= expm2ax;
-          sum1 += coef;
-          sum2 += coef * prodm2ax;
-          sum4 += (coef * prodm2ax) * (a*n);
-          sum3 += coef * prod2ax;
-          sum5 += (coef * prod2ax) * (a*n);
-          // test convergence via sum5, since this sum has the slowest decay
-          if ((coef * prod2ax) * (a*n) < relerr * sum5) break;
-        }
-      }
-    }
-    else { // relerr != DBL_EPSILON, compute exp(-a2*(n*n)) on the fly
-      const double exp2ax = exp((2*a)*x), expm2ax = 1 / exp2ax;
-      if (x < 5e-4) { // compute sum4 and sum5 together as sum5-sum4
-        const double x2 = x*x;
-        expx2 = 1 - x2 * (1 - 0.5*x2); // exp(-x*x) via Taylor
-        for (int n = 1; 1; ++n) {
-          const double coef = exp(-a2*(n*n)) * expx2 / (a2*(n*n) + y*y);
-          prod2ax *= exp2ax;
-          prodm2ax *= expm2ax;
-          sum1 += coef;
-          sum2 += coef * prodm2ax;
-          sum3 += coef * prod2ax;
-          
-          // really = sum5 - sum4
-          sum5 += coef * (2*a) * n * sinh_taylor((2*a)*n*x);
-          
-          // test convergence via sum3
-          if (coef * prod2ax < relerr * sum3) break;
-        }
-      }
-      else { // x > 5e-4, compute sum4 and sum5 separately
-        expx2 = exp(-x*x);
-        for (int n = 1; 1; ++n) {
-          const double coef = exp(-a2*(n*n)) * expx2 / (a2*(n*n) + y*y);
-          prod2ax *= exp2ax;
-          prodm2ax *= expm2ax;
-          sum1 += coef;
-          sum2 += coef * prodm2ax;
-          sum4 += (coef * prodm2ax) * (a*n);
-          sum3 += coef * prod2ax;
-          sum5 += (coef * prod2ax) * (a*n);
-          // test convergence via sum5, since this sum has the slowest decay
-          if ((coef * prod2ax) * (a*n) < relerr * sum5) break;
-        }
-      }
-    }
-    const double expx2erfcxy = // avoid spurious overflow for large negative y
-      y > -6 // for y < -6, erfcx(y) = 2*exp(y*y) to double precision
-      ? expx2*FADDEEVA_RE(erfcx)(y) : 2*exp(y*y-x*x);
-    if (y > 5) { // imaginary terms cancel
-      const double sinxy = sin(x*y);
-      ret = (expx2erfcxy - c*y*sum1) * cos(2*x*y)
-        + (c*x*expx2) * sinxy * sinc(x*y, sinxy);
-    }
-    else {
-      double xs = creal(z);
-      const double sinxy = sin(xs*y);
-      const double sin2xy = sin(2*xs*y), cos2xy = cos(2*xs*y);
-      const double coef1 = expx2erfcxy - c*y*sum1;
-      const double coef2 = c*xs*expx2;
-      ret = C(coef1 * cos2xy + coef2 * sinxy * sinc(xs*y, sinxy),
-              coef2 * sinc(2*xs*y, sin2xy) - coef1 * sin2xy);
-    }
-  }
-  else { // x large: only sum3 & sum5 contribute (see above note)    
-    if (isnan(x))
-      return C(x,x);
-    if (isnan(y))
-      return C(y,y);
-
-#if USE_CONTINUED_FRACTION
-    ret = exp(-x*x); // |y| < 1e-10, so we only need exp(-x*x) term
-#else
-    if (y < 0) {
-      /* erfcx(y) ~ 2*exp(y*y) + (< 1) if y < 0, so
-         erfcx(y)*exp(-x*x) ~ 2*exp(y*y-x*x) term may not be negligible
-         if y*y - x*x > -36 or so.  So, compute this term just in case.
-         We also need the -exp(-x*x) term to compute Re[w] accurately
-         in the case where y is very small. */
-      ret = cpolar(2*exp(y*y-x*x) - exp(-x*x), -2*creal(z)*y);
-    }
-    else
-      ret = exp(-x*x); // not negligible in real part if y very small
-#endif
-    // (round instead of ceil as in original paper; note that x/a > 1 here)
-    double n0 = floor(x/a + 0.5); // sum in both directions, starting at n0
-    double dx = a*n0 - x;
-    sum3 = exp(-dx*dx) / (a2*(n0*n0) + y*y);
-    sum5 = a*n0 * sum3;
-    double exp1 = exp(4*a*dx), exp1dn = 1;
-    int dn;
-    for (dn = 1; n0 - dn > 0; ++dn) { // loop over n0-dn and n0+dn terms
-      double np = n0 + dn, nm = n0 - dn;
-      double tp = exp(-sqr(a*dn+dx));
-      double tm = tp * (exp1dn *= exp1); // trick to get tm from tp
-      tp /= (a2*(np*np) + y*y);
-      tm /= (a2*(nm*nm) + y*y);
-      sum3 += tp + tm;
-      sum5 += a * (np * tp + nm * tm);
-      if (a * (np * tp + nm * tm) < relerr * sum5) goto finish;
-    }
-    while (1) { // loop over n0+dn terms only (since n0-dn <= 0)
-      double np = n0 + dn++;
-      double tp = exp(-sqr(a*dn+dx)) / (a2*(np*np) + y*y);
-      sum3 += tp;
-      sum5 += a * np * tp;
-      if (a * np * tp < relerr * sum5) goto finish;
-    }
-  }
- finish:
-  return ret + C((0.5*c)*y*(sum2+sum3), 
-                 (0.5*c)*copysign(sum5-sum4, creal(z)));
-}
-
-/////////////////////////////////////////////////////////////////////////
-
-/* erfcx(x) = exp(x^2) erfc(x) function, for real x, written by
-   Steven G. Johnson, October 2012.
-
-   This function combines a few different ideas.
-
-   First, for x > 50, it uses a continued-fraction expansion (same as
-   for the Faddeeva function, but with algebraic simplifications for z=i*x).
-
-   Second, for 0 <= x <= 50, it uses Chebyshev polynomial approximations,
-   but with two twists:
-
-      a) It maps x to y = 4 / (4+x) in [0,1].  This simple transformation,
-         inspired by a similar transformation in the octave-forge/specfun
-         erfcx by Soren Hauberg, results in much faster Chebyshev convergence
-         than other simple transformations I have examined.
-
-      b) Instead of using a single Chebyshev polynomial for the entire
-         [0,1] y interval, we break the interval up into 100 equal
-         subintervals, with a switch/lookup table, and use much lower
-         degree Chebyshev polynomials in each subinterval. This greatly
-         improves performance in my tests.
-
-   For x < 0, we use the relationship erfcx(-x) = 2 exp(x^2) - erfc(x),
-   with the usual checks for overflow etcetera.
-
-   Performance-wise, it seems to be substantially faster than either
-   the SLATEC DERFC function [or an erfcx function derived therefrom]
-   or Cody's CALERF function (from netlib.org/specfun), while
-   retaining near machine precision in accuracy.  */
-
-/* Given y100=100*y, where y = 4/(4+x) for x >= 0, compute erfc(x).
-
-   Uses a look-up table of 100 different Chebyshev polynomials
-   for y intervals [0,0.01], [0.01,0.02], ...., [0.99,1], generated
-   with the help of Maple and a little shell script.   This allows
-   the Chebyshev polynomials to be of significantly lower degree (about 1/4)
-   compared to fitting the whole [0,1] interval with a single polynomial. */
-static double erfcx_y100(double y100)
-{
-  switch ((int) y100) {
-case 0: {
-double t = 2*y100 - 1;
-return 0.70878032454106438663e-3 + (0.71234091047026302958e-3 + (0.35779077297597742384e-5 + (0.17403143962587937815e-7 + (0.81710660047307788845e-10 + (0.36885022360434957634e-12 + 0.15917038551111111111e-14 * t) * t) * t) * t) * t) * t;
-}
-case 1: {
-double t = 2*y100 - 3;
-return 0.21479143208285144230e-2 + (0.72686402367379996033e-3 + (0.36843175430938995552e-5 + (0.18071841272149201685e-7 + (0.85496449296040325555e-10 + (0.38852037518534291510e-12 + 0.16868473576888888889e-14 * t) * t) * t) * t) * t) * t;
-}
-case 2: {
-double t = 2*y100 - 5;
-return 0.36165255935630175090e-2 + (0.74182092323555510862e-3 + (0.37948319957528242260e-5 + (0.18771627021793087350e-7 + (0.89484715122415089123e-10 + (0.40935858517772440862e-12 + 0.17872061464888888889e-14 * t) * t) * t) * t) * t) * t;
-}
-case 3: {
-double t = 2*y100 - 7;
-return 0.51154983860031979264e-2 + (0.75722840734791660540e-3 + (0.39096425726735703941e-5 + (0.19504168704300468210e-7 + (0.93687503063178993915e-10 + (0.43143925959079664747e-12 + 0.18939926435555555556e-14 * t) * t) * t) * t) * t) * t;
-}
-case 4: {
-double t = 2*y100 - 9;
-return 0.66457513172673049824e-2 + (0.77310406054447454920e-3 + (0.40289510589399439385e-5 + (0.20271233238288381092e-7 + (0.98117631321709100264e-10 + (0.45484207406017752971e-12 + 0.20076352213333333333e-14 * t) * t) * t) * t) * t) * t;
-}
-case 5: {
-double t = 2*y100 - 11;
-return 0.82082389970241207883e-2 + (0.78946629611881710721e-3 + (0.41529701552622656574e-5 + (0.21074693344544655714e-7 + (0.10278874108587317989e-9 + (0.47965201390613339638e-12 + 0.21285907413333333333e-14 * t) * t) * t) * t) * t) * t;
-}
-case 6: {
-double t = 2*y100 - 13;
-return 0.98039537275352193165e-2 + (0.80633440108342840956e-3 + (0.42819241329736982942e-5 + (0.21916534346907168612e-7 + (0.10771535136565470914e-9 + (0.50595972623692822410e-12 + 0.22573462684444444444e-14 * t) * t) * t) * t) * t) * t;
-}
-case 7: {
-double t = 2*y100 - 15;
-return 0.11433927298290302370e-1 + (0.82372858383196561209e-3 + (0.44160495311765438816e-5 + (0.22798861426211986056e-7 + (0.11291291745879239736e-9 + (0.53386189365816880454e-12 + 0.23944209546666666667e-14 * t) * t) * t) * t) * t) * t;
-}
-case 8: {
-double t = 2*y100 - 17;
-return 0.13099232878814653979e-1 + (0.84167002467906968214e-3 + (0.45555958988457506002e-5 + (0.23723907357214175198e-7 + (0.11839789326602695603e-9 + (0.56346163067550237877e-12 + 0.25403679644444444444e-14 * t) * t) * t) * t) * t) * t;
-}
-case 9: {
-double t = 2*y100 - 19;
-return 0.14800987015587535621e-1 + (0.86018092946345943214e-3 + (0.47008265848816866105e-5 + (0.24694040760197315333e-7 + (0.12418779768752299093e-9 + (0.59486890370320261949e-12 + 0.26957764568888888889e-14 * t) * t) * t) * t) * t) * t;
-}
-case 10: {
-double t = 2*y100 - 21;
-return 0.16540351739394069380e-1 + (0.87928458641241463952e-3 + (0.48520195793001753903e-5 + (0.25711774900881709176e-7 + (0.13030128534230822419e-9 + (0.62820097586874779402e-12 + 0.28612737351111111111e-14 * t) * t) * t) * t) * t) * t;
-}
-case 11: {
-double t = 2*y100 - 23;
-return 0.18318536789842392647e-1 + (0.89900542647891721692e-3 + (0.50094684089553365810e-5 + (0.26779777074218070482e-7 + (0.13675822186304615566e-9 + (0.66358287745352705725e-12 + 0.30375273884444444444e-14 * t) * t) * t) * t) * t) * t;
-}
-case 12: {
-double t = 2*y100 - 25;
-return 0.20136801964214276775e-1 + (0.91936908737673676012e-3 + (0.51734830914104276820e-5 + (0.27900878609710432673e-7 + (0.14357976402809042257e-9 + (0.70114790311043728387e-12 + 0.32252476000000000000e-14 * t) * t) * t) * t) * t) * t;
-}
-case 13: {
-double t = 2*y100 - 27;
-return 0.21996459598282740954e-1 + (0.94040248155366777784e-3 + (0.53443911508041164739e-5 + (0.29078085538049374673e-7 + (0.15078844500329731137e-9 + (0.74103813647499204269e-12 + 0.34251892320000000000e-14 * t) * t) * t) * t) * t) * t;
-}
-case 14: {
-double t = 2*y100 - 29;
-return 0.23898877187226319502e-1 + (0.96213386835900177540e-3 + (0.55225386998049012752e-5 + (0.30314589961047687059e-7 + (0.15840826497296335264e-9 + (0.78340500472414454395e-12 + 0.36381553564444444445e-14 * t) * t) * t) * t) * t) * t;
-}
-case 15: {
-double t = 2*y100 - 31;
-return 0.25845480155298518485e-1 + (0.98459293067820123389e-3 + (0.57082915920051843672e-5 + (0.31613782169164830118e-7 + (0.16646478745529630813e-9 + (0.82840985928785407942e-12 + 0.38649975768888888890e-14 * t) * t) * t) * t) * t) * t;
-}
-case 16: {
-double t = 2*y100 - 33;
-return 0.27837754783474696598e-1 + (0.10078108563256892757e-2 + (0.59020366493792212221e-5 + (0.32979263553246520417e-7 + (0.17498524159268458073e-9 + (0.87622459124842525110e-12 + 0.41066206488888888890e-14 * t) * t) * t) * t) * t) * t;
-}
-case 17: {
-double t = 2*y100 - 35;
-return 0.29877251304899307550e-1 + (0.10318204245057349310e-2 + (0.61041829697162055093e-5 + (0.34414860359542720579e-7 + (0.18399863072934089607e-9 + (0.92703227366365046533e-12 + 0.43639844053333333334e-14 * t) * t) * t) * t) * t) * t;
-}
-case 18: {
-double t = 2*y100 - 37;
-return 0.31965587178596443475e-1 + (0.10566560976716574401e-2 + (0.63151633192414586770e-5 + (0.35924638339521924242e-7 + (0.19353584758781174038e-9 + (0.98102783859889264382e-12 + 0.46381060817777777779e-14 * t) * t) * t) * t) * t) * t;
-}
-case 19: {
-double t = 2*y100 - 39;
-return 0.34104450552588334840e-1 + (0.10823541191350532574e-2 + (0.65354356159553934436e-5 + (0.37512918348533521149e-7 + (0.20362979635817883229e-9 + (0.10384187833037282363e-11 + 0.49300625262222222221e-14 * t) * t) * t) * t) * t) * t;
-}
-case 20: {
-double t = 2*y100 - 41;
-return 0.36295603928292425716e-1 + (0.11089526167995268200e-2 + (0.67654845095518363577e-5 + (0.39184292949913591646e-7 + (0.21431552202133775150e-9 + (0.10994259106646731797e-11 + 0.52409949102222222221e-14 * t) * t) * t) * t) * t) * t;
-}
-case 21: {
-double t = 2*y100 - 43;
-return 0.38540888038840509795e-1 + (0.11364917134175420009e-2 + (0.70058230641246312003e-5 + (0.40943644083718586939e-7 + (0.22563034723692881631e-9 + (0.11642841011361992885e-11 + 0.55721092871111111110e-14 * t) * t) * t) * t) * t) * t;
-}
-case 22: {
-double t = 2*y100 - 45;
-return 0.40842225954785960651e-1 + (0.11650136437945673891e-2 + (0.72569945502343006619e-5 + (0.42796161861855042273e-7 + (0.23761401711005024162e-9 + (0.12332431172381557035e-11 + 0.59246802364444444445e-14 * t) * t) * t) * t) * t) * t;
-}
-case 23: {
-double t = 2*y100 - 47;
-return 0.43201627431540222422e-1 + (0.11945628793917272199e-2 + (0.75195743532849206263e-5 + (0.44747364553960993492e-7 + (0.25030885216472953674e-9 + (0.13065684400300476484e-11 + 0.63000532853333333334e-14 * t) * t) * t) * t) * t) * t;
-}
-case 24: {
-double t = 2*y100 - 49;
-return 0.45621193513810471438e-1 + (0.12251862608067529503e-2 + (0.77941720055551920319e-5 + (0.46803119830954460212e-7 + (0.26375990983978426273e-9 + (0.13845421370977119765e-11 + 0.66996477404444444445e-14 * t) * t) * t) * t) * t) * t;
-}
-case 25: {
-double t = 2*y100 - 51;
-return 0.48103121413299865517e-1 + (0.12569331386432195113e-2 + (0.80814333496367673980e-5 + (0.48969667335682018324e-7 + (0.27801515481905748484e-9 + (0.14674637611609884208e-11 + 0.71249589351111111110e-14 * t) * t) * t) * t) * t) * t;
-}
-case 26: {
-double t = 2*y100 - 53;
-return 0.50649709676983338501e-1 + (0.12898555233099055810e-2 + (0.83820428414568799654e-5 + (0.51253642652551838659e-7 + (0.29312563849675507232e-9 + (0.15556512782814827846e-11 + 0.75775607822222222221e-14 * t) * t) * t) * t) * t) * t;
-}
-case 27: {
-double t = 2*y100 - 55;
-return 0.53263363664388864181e-1 + (0.13240082443256975769e-2 + (0.86967260015007658418e-5 + (0.53662102750396795566e-7 + (0.30914568786634796807e-9 + (0.16494420240828493176e-11 + 0.80591079644444444445e-14 * t) * t) * t) * t) * t) * t;
-}
-case 28: {
-double t = 2*y100 - 57;
-return 0.55946601353500013794e-1 + (0.13594491197408190706e-2 + (0.90262520233016380987e-5 + (0.56202552975056695376e-7 + (0.32613310410503135996e-9 + (0.17491936862246367398e-11 + 0.85713381688888888890e-14 * t) * t) * t) * t) * t) * t;
-}
-case 29: {
-double t = 2*y100 - 59;
-return 0.58702059496154081813e-1 + (0.13962391363223647892e-2 + (0.93714365487312784270e-5 + (0.58882975670265286526e-7 + (0.34414937110591753387e-9 + (0.18552853109751857859e-11 + 0.91160736711111111110e-14 * t) * t) * t) * t) * t) * t;
-}
-case 30: {
-double t = 2*y100 - 61;
-return 0.61532500145144778048e-1 + (0.14344426411912015247e-2 + (0.97331446201016809696e-5 + (0.61711860507347175097e-7 + (0.36325987418295300221e-9 + (0.19681183310134518232e-11 + 0.96952238400000000000e-14 * t) * t) * t) * t) * t) * t;
-}
-case 31: {
-double t = 2*y100 - 63;
-return 0.64440817576653297993e-1 + (0.14741275456383131151e-2 + (0.10112293819576437838e-4 + (0.64698236605933246196e-7 + (0.38353412915303665586e-9 + (0.20881176114385120186e-11 + 0.10310784480000000000e-13 * t) * t) * t) * t) * t) * t;
-}
-case 32: {
-double t = 2*y100 - 65;
-return 0.67430045633130393282e-1 + (0.15153655418916540370e-2 + (0.10509857606888328667e-4 + (0.67851706529363332855e-7 + (0.40504602194811140006e-9 + (0.22157325110542534469e-11 + 0.10964842115555555556e-13 * t) * t) * t) * t) * t) * t;
-}
-case 33: {
-double t = 2*y100 - 67;
-return 0.70503365513338850709e-1 + (0.15582323336495709827e-2 + (0.10926868866865231089e-4 + (0.71182482239613507542e-7 + (0.42787405890153386710e-9 + (0.23514379522274416437e-11 + 0.11659571751111111111e-13 * t) * t) * t) * t) * t) * t;
-}
-case 34: {
-double t = 2*y100 - 69;
-return 0.73664114037944596353e-1 + (0.16028078812438820413e-2 + (0.11364423678778207991e-4 + (0.74701423097423182009e-7 + (0.45210162777476488324e-9 + (0.24957355004088569134e-11 + 0.12397238257777777778e-13 * t) * t) * t) * t) * t) * t;
-}
-case 35: {
-double t = 2*y100 - 71;
-return 0.76915792420819562379e-1 + (0.16491766623447889354e-2 + (0.11823685320041302169e-4 + (0.78420075993781544386e-7 + (0.47781726956916478925e-9 + (0.26491544403815724749e-11 + 0.13180196462222222222e-13 * t) * t) * t) * t) * t) * t;
-}
-case 36: {
-double t = 2*y100 - 73;
-return 0.80262075578094612819e-1 + (0.16974279491709504117e-2 + (0.12305888517309891674e-4 + (0.82350717698979042290e-7 + (0.50511496109857113929e-9 + (0.28122528497626897696e-11 + 0.14010889635555555556e-13 * t) * t) * t) * t) * t) * t;
-}
-case 37: {
-double t = 2*y100 - 75;
-return 0.83706822008980357446e-1 + (0.17476561032212656962e-2 + (0.12812343958540763368e-4 + (0.86506399515036435592e-7 + (0.53409440823869467453e-9 + (0.29856186620887555043e-11 + 0.14891851591111111111e-13 * t) * t) * t) * t) * t) * t;
-}
-case 38: {
-double t = 2*y100 - 77;
-return 0.87254084284461718231e-1 + (0.17999608886001962327e-2 + (0.13344443080089492218e-4 + (0.90900994316429008631e-7 + (0.56486134972616465316e-9 + (0.31698707080033956934e-11 + 0.15825697795555555556e-13 * t) * t) * t) * t) * t) * t;
-}
-case 39: {
-double t = 2*y100 - 79;
-return 0.90908120182172748487e-1 + (0.18544478050657699758e-2 + (0.13903663143426120077e-4 + (0.95549246062549906177e-7 + (0.59752787125242054315e-9 + (0.33656597366099099413e-11 + 0.16815130613333333333e-13 * t) * t) * t) * t) * t) * t;
-}
-case 40: {
-double t = 2*y100 - 81;
-return 0.94673404508075481121e-1 + (0.19112284419887303347e-2 + (0.14491572616545004930e-4 + (0.10046682186333613697e-6 + (0.63221272959791000515e-9 + (0.35736693975589130818e-11 + 0.17862931591111111111e-13 * t) * t) * t) * t) * t) * t;
-}
-case 41: {
-double t = 2*y100 - 83;
-return 0.98554641648004456555e-1 + (0.19704208544725622126e-2 + (0.15109836875625443935e-4 + (0.10567036667675984067e-6 + (0.66904168640019354565e-9 + (0.37946171850824333014e-11 + 0.18971959040000000000e-13 * t) * t) * t) * t) * t) * t;
-}
-case 42: {
-double t = 2*y100 - 85;
-return 0.10255677889470089531e0 + (0.20321499629472857418e-2 + (0.15760224242962179564e-4 + (0.11117756071353507391e-6 + (0.70814785110097658502e-9 + (0.40292553276632563925e-11 + 0.20145143075555555556e-13 * t) * t) * t) * t) * t) * t;
-}
-case 43: {
-double t = 2*y100 - 87;
-return 0.10668502059865093318e0 + (0.20965479776148731610e-2 + (0.16444612377624983565e-4 + (0.11700717962026152749e-6 + (0.74967203250938418991e-9 + (0.42783716186085922176e-11 + 0.21385479360000000000e-13 * t) * t) * t) * t) * t) * t;
-}
-case 44: {
-double t = 2*y100 - 89;
-return 0.11094484319386444474e0 + (0.21637548491908170841e-2 + (0.17164995035719657111e-4 + (0.12317915750735938089e-6 + (0.79376309831499633734e-9 + (0.45427901763106353914e-11 + 0.22696025653333333333e-13 * t) * t) * t) * t) * t) * t;
-}
-case 45: {
-double t = 2*y100 - 91;
-return 0.11534201115268804714e0 + (0.22339187474546420375e-2 + (0.17923489217504226813e-4 + (0.12971465288245997681e-6 + (0.84057834180389073587e-9 + (0.48233721206418027227e-11 + 0.24079890062222222222e-13 * t) * t) * t) * t) * t) * t;
-}
-case 46: {
-double t = 2*y100 - 93;
-return 0.11988259392684094740e0 + (0.23071965691918689601e-2 + (0.18722342718958935446e-4 + (0.13663611754337957520e-6 + (0.89028385488493287005e-9 + (0.51210161569225846701e-11 + 0.25540227111111111111e-13 * t) * t) * t) * t) * t) * t;
-}
-case 47: {
-double t = 2*y100 - 95;
-return 0.12457298393509812907e0 + (0.23837544771809575380e-2 + (0.19563942105711612475e-4 + (0.14396736847739470782e-6 + (0.94305490646459247016e-9 + (0.54366590583134218096e-11 + 0.27080225920000000000e-13 * t) * t) * t) * t) * t) * t;
-}
-case 48: {
-double t = 2*y100 - 97;
-return 0.12941991566142438816e0 + (0.24637684719508859484e-2 + (0.20450821127475879816e-4 + (0.15173366280523906622e-6 + (0.99907632506389027739e-9 + (0.57712760311351625221e-11 + 0.28703099555555555556e-13 * t) * t) * t) * t) * t) * t;
-}
-case 49: {
-double t = 2*y100 - 99;
-return 0.13443048593088696613e0 + (0.25474249981080823877e-2 + (0.21385669591362915223e-4 + (0.15996177579900443030e-6 + (0.10585428844575134013e-8 + (0.61258809536787882989e-11 + 0.30412080142222222222e-13 * t) * t) * t) * t) * t) * t;
-}
-case 50: {
-double t = 2*y100 - 101;
-return 0.13961217543434561353e0 + (0.26349215871051761416e-2 + (0.22371342712572567744e-4 + (0.16868008199296822247e-6 + (0.11216596910444996246e-8 + (0.65015264753090890662e-11 + 0.32210394506666666666e-13 * t) * t) * t) * t) * t) * t;
-}
-case 51: {
-double t = 2*y100 - 103;
-return 0.14497287157673800690e0 + (0.27264675383982439814e-2 + (0.23410870961050950197e-4 + (0.17791863939526376477e-6 + (0.11886425714330958106e-8 + (0.68993039665054288034e-11 + 0.34101266222222222221e-13 * t) * t) * t) * t) * t) * t;
-}
-case 52: {
-double t = 2*y100 - 105;
-return 0.15052089272774618151e0 + (0.28222846410136238008e-2 + (0.24507470422713397006e-4 + (0.18770927679626136909e-6 + (0.12597184587583370712e-8 + (0.73203433049229821618e-11 + 0.36087889048888888890e-13 * t) * t) * t) * t) * t) * t;
-}
-case 53: {
-double t = 2*y100 - 107;
-return 0.15626501395774612325e0 + (0.29226079376196624949e-2 + (0.25664553693768450545e-4 + (0.19808568415654461964e-6 + (0.13351257759815557897e-8 + (0.77658124891046760667e-11 + 0.38173420035555555555e-13 * t) * t) * t) * t) * t) * t;
-}
-case 54: {
-double t = 2*y100 - 109;
-return 0.16221449434620737567e0 + (0.30276865332726475672e-2 + (0.26885741326534564336e-4 + (0.20908350604346384143e-6 + (0.14151148144240728728e-8 + (0.82369170665974313027e-11 + 0.40360957457777777779e-13 * t) * t) * t) * t) * t) * t;
-}
-case 55: {
-double t = 2*y100 - 111;
-return 0.16837910595412130659e0 + (0.31377844510793082301e-2 + (0.28174873844911175026e-4 + (0.22074043807045782387e-6 + (0.14999481055996090039e-8 + (0.87348993661930809254e-11 + 0.42653528977777777779e-13 * t) * t) * t) * t) * t) * t;
-}
-case 56: {
-double t = 2*y100 - 113;
-return 0.17476916455659369953e0 + (0.32531815370903068316e-2 + (0.29536024347344364074e-4 + (0.23309632627767074202e-6 + (0.15899007843582444846e-8 + (0.92610375235427359475e-11 + 0.45054073102222222221e-13 * t) * t) * t) * t) * t) * t;
-}
-case 57: {
-double t = 2*y100 - 115;
-return 0.18139556223643701364e0 + (0.33741744168096996041e-2 + (0.30973511714709500836e-4 + (0.24619326937592290996e-6 + (0.16852609412267750744e-8 + (0.98166442942854895573e-11 + 0.47565418097777777779e-13 * t) * t) * t) * t) * t) * t;
-}
-case 58: {
-double t = 2*y100 - 117;
-return 0.18826980194443664549e0 + (0.35010775057740317997e-2 + (0.32491914440014267480e-4 + (0.26007572375886319028e-6 + (0.17863299617388376116e-8 + (0.10403065638343878679e-10 + 0.50190265831111111110e-13 * t) * t) * t) * t) * t) * t;
-}
-case 59: {
-double t = 2*y100 - 119;
-return 0.19540403413693967350e0 + (0.36342240767211326315e-2 + (0.34096085096200907289e-4 + (0.27479061117017637474e-6 + (0.18934228504790032826e-8 + (0.11021679075323598664e-10 + 0.52931171733333333334e-13 * t) * t) * t) * t) * t) * t;
-}
-case 60: {
-double t = 2*y100 - 121;
-return 0.20281109560651886959e0 + (0.37739673859323597060e-2 + (0.35791165457592409054e-4 + (0.29038742889416172404e-6 + (0.20068685374849001770e-8 + (0.11673891799578381999e-10 + 0.55790523093333333334e-13 * t) * t) * t) * t) * t) * t;
-}
-case 61: {
-double t = 2*y100 - 123;
-return 0.21050455062669334978e0 + (0.39206818613925652425e-2 + (0.37582602289680101704e-4 + (0.30691836231886877385e-6 + (0.21270101645763677824e-8 + (0.12361138551062899455e-10 + 0.58770520160000000000e-13 * t) * t) * t) * t) * t) * t;
-}
-case 62: {
-double t = 2*y100 - 125;
-return 0.21849873453703332479e0 + (0.40747643554689586041e-2 + (0.39476163820986711501e-4 + (0.32443839970139918836e-6 + (0.22542053491518680200e-8 + (0.13084879235290858490e-10 + 0.61873153262222222221e-13 * t) * t) * t) * t) * t) * t;
-}
-case 63: {
-double t = 2*y100 - 127;
-return 0.22680879990043229327e0 + (0.42366354648628516935e-2 + (0.41477956909656896779e-4 + (0.34300544894502810002e-6 + (0.23888264229264067658e-8 + (0.13846596292818514601e-10 + 0.65100183751111111110e-13 * t) * t) * t) * t) * t) * t;
-}
-case 64: {
-double t = 2*y100 - 129;
-return 0.23545076536988703937e0 + (0.44067409206365170888e-2 + (0.43594444916224700881e-4 + (0.36268045617760415178e-6 + (0.25312606430853202748e-8 + (0.14647791812837903061e-10 + 0.68453122631111111110e-13 * t) * t) * t) * t) * t) * t;
-}
-case 65: {
-double t = 2*y100 - 131;
-return 0.24444156740777432838e0 + (0.45855530511605787178e-2 + (0.45832466292683085475e-4 + (0.38352752590033030472e-6 + (0.26819103733055603460e-8 + (0.15489984390884756993e-10 + 0.71933206364444444445e-13 * t) * t) * t) * t) * t) * t;
-}
-case 66: {
-double t = 2*y100 - 133;
-return 0.25379911500634264643e0 + (0.47735723208650032167e-2 + (0.48199253896534185372e-4 + (0.40561404245564732314e-6 + (0.28411932320871165585e-8 + (0.16374705736458320149e-10 + 0.75541379822222222221e-13 * t) * t) * t) * t) * t) * t;
-}
-case 67: {
-double t = 2*y100 - 135;
-return 0.26354234756393613032e0 + (0.49713289477083781266e-2 + (0.50702455036930367504e-4 + (0.42901079254268185722e-6 + (0.30095422058900481753e-8 + (0.17303497025347342498e-10 + 0.79278273368888888890e-13 * t) * t) * t) * t) * t) * t;
-}
-case 68: {
-double t = 2*y100 - 137;
-return 0.27369129607732343398e0 + (0.51793846023052643767e-2 + (0.53350152258326602629e-4 + (0.45379208848865015485e-6 + (0.31874057245814381257e-8 + (0.18277905010245111046e-10 + 0.83144182364444444445e-13 * t) * t) * t) * t) * t) * t;
-}
-case 69: {
-double t = 2*y100 - 139;
-return 0.28426714781640316172e0 + (0.53983341916695141966e-2 + (0.56150884865255810638e-4 + (0.48003589196494734238e-6 + (0.33752476967570796349e-8 + (0.19299477888083469086e-10 + 0.87139049137777777779e-13 * t) * t) * t) * t) * t) * t;
-}
-case 70: {
-double t = 2*y100 - 141;
-return 0.29529231465348519920e0 + (0.56288077305420795663e-2 + (0.59113671189913307427e-4 + (0.50782393781744840482e-6 + (0.35735475025851713168e-8 + (0.20369760937017070382e-10 + 0.91262442613333333334e-13 * t) * t) * t) * t) * t) * t;
-}
-case 71: {
-double t = 2*y100 - 143;
-return 0.30679050522528838613e0 + (0.58714723032745403331e-2 + (0.62248031602197686791e-4 + (0.53724185766200945789e-6 + (0.37827999418960232678e-8 + (0.21490291930444538307e-10 + 0.95513539182222222221e-13 * t) * t) * t) * t) * t) * t;
-}
-case 72: {
-double t = 2*y100 - 145;
-return 0.31878680111173319425e0 + (0.61270341192339103514e-2 + (0.65564012259707640976e-4 + (0.56837930287837738996e-6 + (0.40035151353392378882e-8 + (0.22662596341239294792e-10 + 0.99891109760000000000e-13 * t) * t) * t) * t) * t) * t;
-}
-case 73: {
-double t = 2*y100 - 147;
-return 0.33130773722152622027e0 + (0.63962406646798080903e-2 + (0.69072209592942396666e-4 + (0.60133006661885941812e-6 + (0.42362183765883466691e-8 + (0.23888182347073698382e-10 + 0.10439349811555555556e-12 * t) * t) * t) * t) * t) * t;
-}
-case 74: {
-double t = 2*y100 - 149;
-return 0.34438138658041336523e0 + (0.66798829540414007258e-2 + (0.72783795518603561144e-4 + (0.63619220443228800680e-6 + (0.44814499336514453364e-8 + (0.25168535651285475274e-10 + 0.10901861383111111111e-12 * t) * t) * t) * t) * t) * t;
-}
-case 75: {
-double t = 2*y100 - 151;
-return 0.35803744972380175583e0 + (0.69787978834882685031e-2 + (0.76710543371454822497e-4 + (0.67306815308917386747e-6 + (0.47397647975845228205e-8 + (0.26505114141143050509e-10 + 0.11376390933333333333e-12 * t) * t) * t) * t) * t) * t;
-}
-case 76: {
-double t = 2*y100 - 153;
-return 0.37230734890119724188e0 + (0.72938706896461381003e-2 + (0.80864854542670714092e-4 + (0.71206484718062688779e-6 + (0.50117323769745883805e-8 + (0.27899342394100074165e-10 + 0.11862637614222222222e-12 * t) * t) * t) * t) * t) * t;
-}
-case 77: {
-double t = 2*y100 - 155;
-return 0.38722432730555448223e0 + (0.76260375162549802745e-2 + (0.85259785810004603848e-4 + (0.75329383305171327677e-6 + (0.52979361368388119355e-8 + (0.29352606054164086709e-10 + 0.12360253370666666667e-12 * t) * t) * t) * t) * t) * t;
-}
-case 78: {
-double t = 2*y100 - 157;
-return 0.40282355354616940667e0 + (0.79762880915029728079e-2 + (0.89909077342438246452e-4 + (0.79687137961956194579e-6 + (0.55989731807360403195e-8 + (0.30866246101464869050e-10 + 0.12868841946666666667e-12 * t) * t) * t) * t) * t) * t;
-}
-case 79: {
-double t = 2*y100 - 159;
-return 0.41914223158913787649e0 + (0.83456685186950463538e-2 + (0.94827181359250161335e-4 + (0.84291858561783141014e-6 + (0.59154537751083485684e-8 + (0.32441553034347469291e-10 + 0.13387957943111111111e-12 * t) * t) * t) * t) * t) * t;
-}
-case 80: {
-double t = 2*y100 - 161;
-return 0.43621971639463786896e0 + (0.87352841828289495773e-2 + (0.10002929142066799966e-3 + (0.89156148280219880024e-6 + (0.62480008150788597147e-8 + (0.34079760983458878910e-10 + 0.13917107176888888889e-12 * t) * t) * t) * t) * t) * t;
-}
-case 81: {
-double t = 2*y100 - 163;
-return 0.45409763548534330981e0 + (0.91463027755548240654e-2 + (0.10553137232446167258e-3 + (0.94293113464638623798e-6 + (0.65972492312219959885e-8 + (0.35782041795476563662e-10 + 0.14455745872000000000e-12 * t) * t) * t) * t) * t) * t;
-}
-case 82: {
-double t = 2*y100 - 165;
-return 0.47282001668512331468e0 + (0.95799574408860463394e-2 + (0.11135019058000067469e-3 + (0.99716373005509038080e-6 + (0.69638453369956970347e-8 + (0.37549499088161345850e-10 + 0.15003280712888888889e-12 * t) * t) * t) * t) * t) * t;
-}
-case 83: {
-double t = 2*y100 - 167;
-return 0.49243342227179841649e0 + (0.10037550043909497071e-1 + (0.11750334542845234952e-3 + (0.10544006716188967172e-5 + (0.73484461168242224872e-8 + (0.39383162326435752965e-10 + 0.15559069118222222222e-12 * t) * t) * t) * t) * t) * t;
-}
-case 84: {
-double t = 2*y100 - 169;
-return 0.51298708979209258326e0 + (0.10520454564612427224e-1 + (0.12400930037494996655e-3 + (0.11147886579371265246e-5 + (0.77517184550568711454e-8 + (0.41283980931872622611e-10 + 0.16122419680000000000e-12 * t) * t) * t) * t) * t) * t;
-}
-case 85: {
-double t = 2*y100 - 171;
-return 0.53453307979101369843e0 + (0.11030120618800726938e-1 + (0.13088741519572269581e-3 + (0.11784797595374515432e-5 + (0.81743383063044825400e-8 + (0.43252818449517081051e-10 + 0.16692592640000000000e-12 * t) * t) * t) * t) * t) * t;
-}
-case 86: {
-double t = 2*y100 - 173;
-return 0.55712643071169299478e0 + (0.11568077107929735233e-1 + (0.13815797838036651289e-3 + (0.12456314879260904558e-5 + (0.86169898078969313597e-8 + (0.45290446811539652525e-10 + 0.17268801084444444444e-12 * t) * t) * t) * t) * t) * t;
-}
-case 87: {
-double t = 2*y100 - 175;
-return 0.58082532122519320968e0 + (0.12135935999503877077e-1 + (0.14584223996665838559e-3 + (0.13164068573095710742e-5 + (0.90803643355106020163e-8 + (0.47397540713124619155e-10 + 0.17850211608888888889e-12 * t) * t) * t) * t) * t) * t;
-}
-case 88: {
-double t = 2*y100 - 177;
-return 0.60569124025293375554e0 + (0.12735396239525550361e-1 + (0.15396244472258863344e-3 + (0.13909744385382818253e-5 + (0.95651595032306228245e-8 + (0.49574672127669041550e-10 + 0.18435945564444444444e-12 * t) * t) * t) * t) * t) * t;
-}
-case 89: {
-double t = 2*y100 - 179;
-return 0.63178916494715716894e0 + (0.13368247798287030927e-1 + (0.16254186562762076141e-3 + (0.14695084048334056083e-5 + (0.10072078109604152350e-7 + (0.51822304995680707483e-10 + 0.19025081422222222222e-12 * t) * t) * t) * t) * t) * t;
-}
-case 90: {
-double t = 2*y100 - 181;
-return 0.65918774689725319200e0 + (0.14036375850601992063e-1 + (0.17160483760259706354e-3 + (0.15521885688723188371e-5 + (0.10601827031535280590e-7 + (0.54140790105837520499e-10 + 0.19616655146666666667e-12 * t) * t) * t) * t) * t) * t;
-}
-case 91: {
-double t = 2*y100 - 183;
-return 0.68795950683174433822e0 + (0.14741765091365869084e-1 + (0.18117679143520433835e-3 + (0.16392004108230585213e-5 + (0.11155116068018043001e-7 + (0.56530360194925690374e-10 + 0.20209663662222222222e-12 * t) * t) * t) * t) * t) * t;
-}
-case 92: {
-double t = 2*y100 - 185;
-return 0.71818103808729967036e0 + (0.15486504187117112279e-1 + (0.19128428784550923217e-3 + (0.17307350969359975848e-5 + (0.11732656736113607751e-7 + (0.58991125287563833603e-10 + 0.20803065333333333333e-12 * t) * t) * t) * t) * t) * t;
-}
-case 93: {
-double t = 2*y100 - 187;
-return 0.74993321911726254661e0 + (0.16272790364044783382e-1 + (0.20195505163377912645e-3 + (0.18269894883203346953e-5 + (0.12335161021630225535e-7 + (0.61523068312169087227e-10 + 0.21395783431111111111e-12 * t) * t) * t) * t) * t) * t;
-}
-case 94: {
-double t = 2*y100 - 189;
-return 0.78330143531283492729e0 + (0.17102934132652429240e-1 + (0.21321800585063327041e-3 + (0.19281661395543913713e-5 + (0.12963340087354341574e-7 + (0.64126040998066348872e-10 + 0.21986708942222222222e-12 * t) * t) * t) * t) * t) * t;
-}
-case 95: {
-double t = 2*y100 - 191;
-return 0.81837581041023811832e0 + (0.17979364149044223802e-1 + (0.22510330592753129006e-3 + (0.20344732868018175389e-5 + (0.13617902941839949718e-7 + (0.66799760083972474642e-10 + 0.22574701262222222222e-12 * t) * t) * t) * t) * t) * t;
-}
-case 96: {
-double t = 2*y100 - 193;
-return 0.85525144775685126237e0 + (0.18904632212547561026e-1 + (0.23764237370371255638e-3 + (0.21461248251306387979e-5 + (0.14299555071870523786e-7 + (0.69543803864694171934e-10 + 0.23158593688888888889e-12 * t) * t) * t) * t) * t) * t;
-}
-case 97: {
-double t = 2*y100 - 195;
-return 0.89402868170849933734e0 + (0.19881418399127202569e-1 + (0.25086793128395995798e-3 + (0.22633402747585233180e-5 + (0.15008997042116532283e-7 + (0.72357609075043941261e-10 + 0.23737194737777777778e-12 * t) * t) * t) * t) * t) * t;
-}
-case 98: {
-double t = 2*y100 - 197;
-return 0.93481333942870796363e0 + (0.20912536329780368893e-1 + (0.26481403465998477969e-3 + (0.23863447359754921676e-5 + (0.15746923065472184451e-7 + (0.75240468141720143653e-10 + 0.24309291271111111111e-12 * t) * t) * t) * t) * t) * t;
-}
-case 99: {
-double t = 2*y100 - 199;
-return 0.97771701335885035464e0 + (0.22000938572830479551e-1 + (0.27951610702682383001e-3 + (0.25153688325245314530e-5 + (0.16514019547822821453e-7 + (0.78191526829368231251e-10 + 0.24873652355555555556e-12 * t) * t) * t) * t) * t) * t;
-}
-  }
-  // we only get here if y = 1, i.e. |x| < 4*eps, in which case
-  // erfcx is within 1e-15 of 1..
-  return 1.0;
-}
-
-double FADDEEVA_RE(erfcx)(double x)
-{
-  if (x >= 0) {
-    if (x > 50) { // continued-fraction expansion is faster
-      const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
-      if (x > 5e7) // 1-term expansion, important to avoid overflow
-        return ispi / x;
-      /* 5-term expansion (rely on compiler for CSE), simplified from:
-                ispi / (x+0.5/(x+1/(x+1.5/(x+2/x))))  */
-      return ispi*((x*x) * (x*x+4.5) + 2) / (x * ((x*x) * (x*x+5) + 3.75));
-    }
-    return erfcx_y100(400/(4+x));
-  }
-  else
-    return x < -26.7 ? HUGE_VAL : (x < -6.1 ? 2*exp(x*x) 
-                                   : 2*exp(x*x) - erfcx_y100(400/(4-x)));
-}
-
-/////////////////////////////////////////////////////////////////////////
-/* Compute a scaled Dawson integral 
-            FADDEEVA(w_im)(x) = 2*Dawson(x)/sqrt(pi)
-   equivalent to the imaginary part w(x) for real x.
-
-   Uses methods similar to the erfcx calculation above: continued fractions
-   for large |x|, a lookup table of Chebyshev polynomials for smaller |x|,
-   and finally a Taylor expansion for |x|<0.01.
-   
-   Steven G. Johnson, October 2012. */
-
-/* Given y100=100*y, where y = 1/(1+x) for x >= 0, compute w_im(x).
-
-   Uses a look-up table of 100 different Chebyshev polynomials
-   for y intervals [0,0.01], [0.01,0.02], ...., [0.99,1], generated
-   with the help of Maple and a little shell script.   This allows
-   the Chebyshev polynomials to be of significantly lower degree (about 1/30)
-   compared to fitting the whole [0,1] interval with a single polynomial. */
-static double w_im_y100(double y100, double x) {
-  switch ((int) y100) {
-    case 0: {
-      double t = 2*y100 - 1;
-      return 0.28351593328822191546e-2 + (0.28494783221378400759e-2 + (0.14427470563276734183e-4 + (0.10939723080231588129e-6 + (0.92474307943275042045e-9 + (0.89128907666450075245e-11 + 0.92974121935111111110e-13 * t) * t) * t) * t) * t) * t;
-    }
-    case 1: {
-      double t = 2*y100 - 3;
-      return 0.85927161243940350562e-2 + (0.29085312941641339862e-2 + (0.15106783707725582090e-4 + (0.11716709978531327367e-6 + (0.10197387816021040024e-8 + (0.10122678863073360769e-10 + 0.10917479678400000000e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 2: {
-      double t = 2*y100 - 5;
-      return 0.14471159831187703054e-1 + (0.29703978970263836210e-2 + (0.15835096760173030976e-4 + (0.12574803383199211596e-6 + (0.11278672159518415848e-8 + (0.11547462300333495797e-10 + 0.12894535335111111111e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 3: {
-      double t = 2*y100 - 7;
-      return 0.20476320420324610618e-1 + (0.30352843012898665856e-2 + (0.16617609387003727409e-4 + (0.13525429711163116103e-6 + (0.12515095552507169013e-8 + (0.13235687543603382345e-10 + 0.15326595042666666667e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 4: {
-      double t = 2*y100 - 9;
-      return 0.26614461952489004566e-1 + (0.31034189276234947088e-2 + (0.17460268109986214274e-4 + (0.14582130824485709573e-6 + (0.13935959083809746345e-8 + (0.15249438072998932900e-10 + 0.18344741882133333333e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 5: {
-      double t = 2*y100 - 11;
-      return 0.32892330248093586215e-1 + (0.31750557067975068584e-2 + (0.18369907582308672632e-4 + (0.15761063702089457882e-6 + (0.15577638230480894382e-8 + (0.17663868462699097951e-10 + (0.22126732680711111111e-12 + 0.30273474177737853668e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 6: {
-      double t = 2*y100 - 13;
-      return 0.39317207681134336024e-1 + (0.32504779701937539333e-2 + (0.19354426046513400534e-4 + (0.17081646971321290539e-6 + (0.17485733959327106250e-8 + (0.20593687304921961410e-10 + (0.26917401949155555556e-12 + 0.38562123837725712270e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 7: {
-      double t = 2*y100 - 15;
-      return 0.45896976511367738235e-1 + (0.33300031273110976165e-2 + (0.20423005398039037313e-4 + (0.18567412470376467303e-6 + (0.19718038363586588213e-8 + (0.24175006536781219807e-10 + (0.33059982791466666666e-12 + 0.49756574284439426165e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 8: {
-      double t = 2*y100 - 17;
-      return 0.52640192524848962855e-1 + (0.34139883358846720806e-2 + (0.21586390240603337337e-4 + (0.20247136501568904646e-6 + (0.22348696948197102935e-8 + (0.28597516301950162548e-10 + (0.41045502119111111110e-12 + 0.65151614515238361946e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 9: {
-      double t = 2*y100 - 19;
-      return 0.59556171228656770456e-1 + (0.35028374386648914444e-2 + (0.22857246150998562824e-4 + (0.22156372146525190679e-6 + (0.25474171590893813583e-8 + (0.34122390890697400584e-10 + (0.51593189879111111110e-12 + 0.86775076853908006938e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 10: {
-      double t = 2*y100 - 21;
-      return 0.66655089485108212551e-1 + (0.35970095381271285568e-2 + (0.24250626164318672928e-4 + (0.24339561521785040536e-6 + (0.29221990406518411415e-8 + (0.41117013527967776467e-10 + (0.65786450716444444445e-12 + 0.11791885745450623331e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 11: {
-      double t = 2*y100 - 23;
-      return 0.73948106345519174661e-1 + (0.36970297216569341748e-2 + (0.25784588137312868792e-4 + (0.26853012002366752770e-6 + (0.33763958861206729592e-8 + (0.50111549981376976397e-10 + (0.85313857496888888890e-12 + 0.16417079927706899860e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 12: {
-      double t = 2*y100 - 25;
-      return 0.81447508065002963203e-1 + (0.38035026606492705117e-2 + (0.27481027572231851896e-4 + (0.29769200731832331364e-6 + (0.39336816287457655076e-8 + (0.61895471132038157624e-10 + (0.11292303213511111111e-11 + 0.23558532213703884304e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 13: {
-      double t = 2*y100 - 27;
-      return 0.89166884027582716628e-1 + (0.39171301322438946014e-2 + (0.29366827260422311668e-4 + (0.33183204390350724895e-6 + (0.46276006281647330524e-8 + (0.77692631378169813324e-10 + (0.15335153258844444444e-11 + 0.35183103415916026911e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 14: {
-      double t = 2*y100 - 29;
-      return 0.97121342888032322019e-1 + (0.40387340353207909514e-2 + (0.31475490395950776930e-4 + (0.37222714227125135042e-6 + (0.55074373178613809996e-8 + (0.99509175283990337944e-10 + (0.21552645758222222222e-11 + 0.55728651431872687605e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 15: {
-      double t = 2*y100 - 31;
-      return 0.10532778218603311137e0 + (0.41692873614065380607e-2 + (0.33849549774889456984e-4 + (0.42064596193692630143e-6 + (0.66494579697622432987e-8 + (0.13094103581931802337e-9 + (0.31896187409777777778e-11 + 0.97271974184476560742e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 16: {
-      double t = 2*y100 - 33;
-      return 0.11380523107427108222e0 + (0.43099572287871821013e-2 + (0.36544324341565929930e-4 + (0.47965044028581857764e-6 + (0.81819034238463698796e-8 + (0.17934133239549647357e-9 + (0.50956666166186293627e-11 + (0.18850487318190638010e-12 + 0.79697813173519853340e-14 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 17: {
-      double t = 2*y100 - 35;
-      return 0.12257529703447467345e0 + (0.44621675710026986366e-2 + (0.39634304721292440285e-4 + (0.55321553769873381819e-6 + (0.10343619428848520870e-7 + (0.26033830170470368088e-9 + (0.87743837749108025357e-11 + (0.34427092430230063401e-12 + 0.10205506615709843189e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 18: {
-      double t = 2*y100 - 37;
-      return 0.13166276955656699478e0 + (0.46276970481783001803e-2 + (0.43225026380496399310e-4 + (0.64799164020016902656e-6 + (0.13580082794704641782e-7 + (0.39839800853954313927e-9 + (0.14431142411840000000e-10 + 0.42193457308830027541e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 19: {
-      double t = 2*y100 - 39;
-      return 0.14109647869803356475e0 + (0.48088424418545347758e-2 + (0.47474504753352150205e-4 + (0.77509866468724360352e-6 + (0.18536851570794291724e-7 + (0.60146623257887570439e-9 + (0.18533978397305276318e-10 + (0.41033845938901048380e-13 - 0.46160680279304825485e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 20: {
-      double t = 2*y100 - 41;
-      return 0.15091057940548936603e0 + (0.50086864672004685703e-2 + (0.52622482832192230762e-4 + (0.95034664722040355212e-6 + (0.25614261331144718769e-7 + (0.80183196716888606252e-9 + (0.12282524750534352272e-10 + (-0.10531774117332273617e-11 - 0.86157181395039646412e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 21: {
-      double t = 2*y100 - 43;
-      return 0.16114648116017010770e0 + (0.52314661581655369795e-2 + (0.59005534545908331315e-4 + (0.11885518333915387760e-5 + (0.33975801443239949256e-7 + (0.82111547144080388610e-9 + (-0.12357674017312854138e-10 + (-0.24355112256914479176e-11 - 0.75155506863572930844e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 22: {
-      double t = 2*y100 - 45;
-      return 0.17185551279680451144e0 + (0.54829002967599420860e-2 + (0.67013226658738082118e-4 + (0.14897400671425088807e-5 + (0.40690283917126153701e-7 + (0.44060872913473778318e-9 + (-0.52641873433280000000e-10 - 0.30940587864543343124e-11 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 23: {
-      double t = 2*y100 - 47;
-      return 0.18310194559815257381e0 + (0.57701559375966953174e-2 + (0.76948789401735193483e-4 + (0.18227569842290822512e-5 + (0.41092208344387212276e-7 + (-0.44009499965694442143e-9 + (-0.92195414685628803451e-10 + (-0.22657389705721753299e-11 + 0.10004784908106839254e-12 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 24: {
-      double t = 2*y100 - 49;
-      return 0.19496527191546630345e0 + (0.61010853144364724856e-2 + (0.88812881056342004864e-4 + (0.21180686746360261031e-5 + (0.30652145555130049203e-7 + (-0.16841328574105890409e-8 + (-0.11008129460612823934e-9 + (-0.12180794204544515779e-12 + 0.15703325634590334097e-12 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 25: {
-      double t = 2*y100 - 51;
-      return 0.20754006813966575720e0 + (0.64825787724922073908e-2 + (0.10209599627522311893e-3 + (0.22785233392557600468e-5 + (0.73495224449907568402e-8 + (-0.29442705974150112783e-8 + (-0.94082603434315016546e-10 + (0.23609990400179321267e-11 + 0.14141908654269023788e-12 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 26: {
-      double t = 2*y100 - 53;
-      return 0.22093185554845172146e0 + (0.69182878150187964499e-2 + (0.11568723331156335712e-3 + (0.22060577946323627739e-5 + (-0.26929730679360840096e-7 + (-0.38176506152362058013e-8 + (-0.47399503861054459243e-10 + (0.40953700187172127264e-11 + 0.69157730376118511127e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 27: {
-      double t = 2*y100 - 55;
-      return 0.23524827304057813918e0 + (0.74063350762008734520e-2 + (0.12796333874615790348e-3 + (0.18327267316171054273e-5 + (-0.66742910737957100098e-7 + (-0.40204740975496797870e-8 + (0.14515984139495745330e-10 + (0.44921608954536047975e-11 - 0.18583341338983776219e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 28: {
-      double t = 2*y100 - 57;
-      return 0.25058626331812744775e0 + (0.79377285151602061328e-2 + (0.13704268650417478346e-3 + (0.11427511739544695861e-5 + (-0.10485442447768377485e-6 + (-0.34850364756499369763e-8 + (0.72656453829502179208e-10 + (0.36195460197779299406e-11 - 0.84882136022200714710e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 29: {
-      double t = 2*y100 - 59;
-      return 0.26701724900280689785e0 + (0.84959936119625864274e-2 + (0.14112359443938883232e-3 + (0.17800427288596909634e-6 + (-0.13443492107643109071e-6 + (-0.23512456315677680293e-8 + (0.11245846264695936769e-9 + (0.19850501334649565404e-11 - 0.11284666134635050832e-12 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 30: {
-      double t = 2*y100 - 61;
-      return 0.28457293586253654144e0 + (0.90581563892650431899e-2 + (0.13880520331140646738e-3 + (-0.97262302362522896157e-6 + (-0.15077100040254187366e-6 + (-0.88574317464577116689e-9 + (0.12760311125637474581e-9 + (0.20155151018282695055e-12 - 0.10514169375181734921e-12 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 31: {
-      double t = 2*y100 - 63;
-      return 0.30323425595617385705e0 + (0.95968346790597422934e-2 + (0.12931067776725883939e-3 + (-0.21938741702795543986e-5 + (-0.15202888584907373963e-6 + (0.61788350541116331411e-9 + (0.11957835742791248256e-9 + (-0.12598179834007710908e-11 - 0.75151817129574614194e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 32: {
-      double t = 2*y100 - 65;
-      return 0.32292521181517384379e0 + (0.10082957727001199408e-1 + (0.11257589426154962226e-3 + (-0.33670890319327881129e-5 + (-0.13910529040004008158e-6 + (0.19170714373047512945e-8 + (0.94840222377720494290e-10 + (-0.21650018351795353201e-11 - 0.37875211678024922689e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 33: {
-      double t = 2*y100 - 67;
-      return 0.34351233557911753862e0 + (0.10488575435572745309e-1 + (0.89209444197248726614e-4 + (-0.43893459576483345364e-5 + (-0.11488595830450424419e-6 + (0.28599494117122464806e-8 + (0.61537542799857777779e-10 - 0.24935749227658002212e-11 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 34: {
-      double t = 2*y100 - 69;
-      return 0.36480946642143669093e0 + (0.10789304203431861366e-1 + (0.60357993745283076834e-4 + (-0.51855862174130669389e-5 + (-0.83291664087289801313e-7 + (0.33898011178582671546e-8 + (0.27082948188277716482e-10 + (-0.23603379397408694974e-11 + 0.19328087692252869842e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 35: {
-      double t = 2*y100 - 71;
-      return 0.38658679935694939199e0 + (0.10966119158288804999e-1 + (0.27521612041849561426e-4 + (-0.57132774537670953638e-5 + (-0.48404772799207914899e-7 + (0.35268354132474570493e-8 + (-0.32383477652514618094e-11 + (-0.19334202915190442501e-11 + 0.32333189861286460270e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 36: {
-      double t = 2*y100 - 73;
-      return 0.40858275583808707870e0 + (0.11006378016848466550e-1 + (-0.76396376685213286033e-5 + (-0.59609835484245791439e-5 + (-0.13834610033859313213e-7 + (0.33406952974861448790e-8 + (-0.26474915974296612559e-10 + (-0.13750229270354351983e-11 + 0.36169366979417390637e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 37: {
-      double t = 2*y100 - 75;
-      return 0.43051714914006682977e0 + (0.10904106549500816155e-1 + (-0.43477527256787216909e-4 + (-0.59429739547798343948e-5 + (0.17639200194091885949e-7 + (0.29235991689639918688e-8 + (-0.41718791216277812879e-10 + (-0.81023337739508049606e-12 + 0.33618915934461994428e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 38: {
-      double t = 2*y100 - 77;
-      return 0.45210428135559607406e0 + (0.10659670756384400554e-1 + (-0.78488639913256978087e-4 + (-0.56919860886214735936e-5 + (0.44181850467477733407e-7 + (0.23694306174312688151e-8 + (-0.49492621596685443247e-10 + (-0.31827275712126287222e-12 + 0.27494438742721623654e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 39: {
-      double t = 2*y100 - 79;
-      return 0.47306491195005224077e0 + (0.10279006119745977570e-1 + (-0.11140268171830478306e-3 + (-0.52518035247451432069e-5 + (0.64846898158889479518e-7 + (0.17603624837787337662e-8 + (-0.51129481592926104316e-10 + (0.62674584974141049511e-13 + 0.20055478560829935356e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 40: {
-      double t = 2*y100 - 81;
-      return 0.49313638965719857647e0 + (0.97725799114772017662e-2 + (-0.14122854267291533334e-3 + (-0.46707252568834951907e-5 + (0.79421347979319449524e-7 + (0.11603027184324708643e-8 + (-0.48269605844397175946e-10 + (0.32477251431748571219e-12 + 0.12831052634143527985e-13 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 41: {
-      double t = 2*y100 - 83;
-      return 0.51208057433416004042e0 + (0.91542422354009224951e-2 + (-0.16726530230228647275e-3 + (-0.39964621752527649409e-5 + (0.88232252903213171454e-7 + (0.61343113364949928501e-9 + (-0.42516755603130443051e-10 + (0.47910437172240209262e-12 + 0.66784341874437478953e-14 * t) * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 42: {
-      double t = 2*y100 - 85;
-      return 0.52968945458607484524e0 + (0.84400880445116786088e-2 + (-0.18908729783854258774e-3 + (-0.32725905467782951931e-5 + (0.91956190588652090659e-7 + (0.14593989152420122909e-9 + (-0.35239490687644444445e-10 + 0.54613829888448694898e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 43: {
-      double t = 2*y100 - 87;
-      return 0.54578857454330070965e0 + (0.76474155195880295311e-2 + (-0.20651230590808213884e-3 + (-0.25364339140543131706e-5 + (0.91455367999510681979e-7 + (-0.23061359005297528898e-9 + (-0.27512928625244444444e-10 + 0.54895806008493285579e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 44: {
-      double t = 2*y100 - 89;
-      return 0.56023851910298493910e0 + (0.67938321739997196804e-2 + (-0.21956066613331411760e-3 + (-0.18181127670443266395e-5 + (0.87650335075416845987e-7 + (-0.51548062050366615977e-9 + (-0.20068462174044444444e-10 + 0.50912654909758187264e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 45: {
-      double t = 2*y100 - 91;
-      return 0.57293478057455721150e0 + (0.58965321010394044087e-2 + (-0.22841145229276575597e-3 + (-0.11404605562013443659e-5 + (0.81430290992322326296e-7 + (-0.71512447242755357629e-9 + (-0.13372664928000000000e-10 + 0.44461498336689298148e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 46: {
-      double t = 2*y100 - 93;
-      return 0.58380635448407827360e0 + (0.49717469530842831182e-2 + (-0.23336001540009645365e-3 + (-0.51952064448608850822e-6 + (0.73596577815411080511e-7 + (-0.84020916763091566035e-9 + (-0.76700972702222222221e-11 + 0.36914462807972467044e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 47: {
-      double t = 2*y100 - 95;
-      return 0.59281340237769489597e0 + (0.40343592069379730568e-2 + (-0.23477963738658326185e-3 + (0.34615944987790224234e-7 + (0.64832803248395814574e-7 + (-0.90329163587627007971e-9 + (-0.30421940400000000000e-11 + 0.29237386653743536669e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 48: {
-      double t = 2*y100 - 97;
-      return 0.59994428743114271918e0 + (0.30976579788271744329e-2 + (-0.23308875765700082835e-3 + (0.51681681023846925160e-6 + (0.55694594264948268169e-7 + (-0.91719117313243464652e-9 + (0.53982743680000000000e-12 + 0.22050829296187771142e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 49: {
-      double t = 2*y100 - 99;
-      return 0.60521224471819875444e0 + (0.21732138012345456060e-2 + (-0.22872428969625997456e-3 + (0.92588959922653404233e-6 + (0.46612665806531930684e-7 + (-0.89393722514414153351e-9 + (0.31718550353777777778e-11 + 0.15705458816080549117e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 50: {
-      double t = 2*y100 - 101;
-      return 0.60865189969791123620e0 + (0.12708480848877451719e-2 + (-0.22212090111534847166e-3 + (0.12636236031532793467e-5 + (0.37904037100232937574e-7 + (-0.84417089968101223519e-9 + (0.49843180828444444445e-11 + 0.10355439441049048273e-12 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 51: {
-      double t = 2*y100 - 103;
-      return 0.61031580103499200191e0 + (0.39867436055861038223e-3 + (-0.21369573439579869291e-3 + (0.15339402129026183670e-5 + (0.29787479206646594442e-7 + (-0.77687792914228632974e-9 + (0.61192452741333333334e-11 + 0.60216691829459295780e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 52: {
-      double t = 2*y100 - 105;
-      return 0.61027109047879835868e0 + (-0.43680904508059878254e-3 + (-0.20383783788303894442e-3 + (0.17421743090883439959e-5 + (0.22400425572175715576e-7 + (-0.69934719320045128997e-9 + (0.67152759655111111110e-11 + 0.26419960042578359995e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 53: {
-      double t = 2*y100 - 107;
-      return 0.60859639489217430521e0 + (-0.12305921390962936873e-2 + (-0.19290150253894682629e-3 + (0.18944904654478310128e-5 + (0.15815530398618149110e-7 + (-0.61726850580964876070e-9 + 0.68987888999111111110e-11 * t) * t) * t) * t) * t) * t;
-    }
-    case 54: {
-      double t = 2*y100 - 109;
-      return 0.60537899426486075181e0 + (-0.19790062241395705751e-2 + (-0.18120271393047062253e-3 + (0.19974264162313241405e-5 + (0.10055795094298172492e-7 + (-0.53491997919318263593e-9 + (0.67794550295111111110e-11 - 0.17059208095741511603e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 55: {
-      double t = 2*y100 - 111;
-      return 0.60071229457904110537e0 + (-0.26795676776166354354e-2 + (-0.16901799553627508781e-3 + (0.20575498324332621581e-5 + (0.51077165074461745053e-8 + (-0.45536079828057221858e-9 + (0.64488005516444444445e-11 - 0.29311677573152766338e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 56: {
-      double t = 2*y100 - 113;
-      return 0.59469361520112714738e0 + (-0.33308208190600993470e-2 + (-0.15658501295912405679e-3 + (0.20812116912895417272e-5 + (0.93227468760614182021e-9 + (-0.38066673740116080415e-9 + (0.59806790359111111110e-11 - 0.36887077278950440597e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 57: {
-      double t = 2*y100 - 115;
-      return 0.58742228631775388268e0 + (-0.39321858196059227251e-2 + (-0.14410441141450122535e-3 + (0.20743790018404020716e-5 + (-0.25261903811221913762e-8 + (-0.31212416519526924318e-9 + (0.54328422462222222221e-11 - 0.40864152484979815972e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 58: {
-      double t = 2*y100 - 117;
-      return 0.57899804200033018447e0 + (-0.44838157005618913447e-2 + (-0.13174245966501437965e-3 + (0.20425306888294362674e-5 + (-0.53330296023875447782e-8 + (-0.25041289435539821014e-9 + (0.48490437205333333334e-11 - 0.42162206939169045177e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 59: {
-      double t = 2*y100 - 119;
-      return 0.56951968796931245974e0 + (-0.49864649488074868952e-2 + (-0.11963416583477567125e-3 + (0.19906021780991036425e-5 + (-0.75580140299436494248e-8 + (-0.19576060961919820491e-9 + (0.42613011928888888890e-11 - 0.41539443304115604377e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 60: {
-      double t = 2*y100 - 121;
-      return 0.55908401930063918964e0 + (-0.54413711036826877753e-2 + (-0.10788661102511914628e-3 + (0.19229663322982839331e-5 + (-0.92714731195118129616e-8 + (-0.14807038677197394186e-9 + (0.36920870298666666666e-11 - 0.39603726688419162617e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 61: {
-      double t = 2*y100 - 123;
-      return 0.54778496152925675315e0 + (-0.58501497933213396670e-2 + (-0.96582314317855227421e-4 + (0.18434405235069270228e-5 + (-0.10541580254317078711e-7 + (-0.10702303407788943498e-9 + (0.31563175582222222222e-11 - 0.36829748079110481422e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 62: {
-      double t = 2*y100 - 125;
-      return 0.53571290831682823999e0 + (-0.62147030670760791791e-2 + (-0.85782497917111760790e-4 + (0.17553116363443470478e-5 + (-0.11432547349815541084e-7 + (-0.72157091369041330520e-10 + (0.26630811607111111111e-11 - 0.33578660425893164084e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 63: {
-      double t = 2*y100 - 127;
-      return 0.52295422962048434978e0 + (-0.65371404367776320720e-2 + (-0.75530164941473343780e-4 + (0.16613725797181276790e-5 + (-0.12003521296598910761e-7 + (-0.42929753689181106171e-10 + (0.22170894940444444444e-11 - 0.30117697501065110505e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 64: {
-      double t = 2*y100 - 129;
-      return 0.50959092577577886140e0 + (-0.68197117603118591766e-2 + (-0.65852936198953623307e-4 + (0.15639654113906716939e-5 + (-0.12308007991056524902e-7 + (-0.18761997536910939570e-10 + (0.18198628922666666667e-11 - 0.26638355362285200932e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 65: {
-      double t = 2*y100 - 131;
-      return 0.49570040481823167970e0 + (-0.70647509397614398066e-2 + (-0.56765617728962588218e-4 + (0.14650274449141448497e-5 + (-0.12393681471984051132e-7 + (0.92904351801168955424e-12 + (0.14706755960177777778e-11 - 0.23272455351266325318e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 66: {
-      double t = 2*y100 - 133;
-      return 0.48135536250935238066e0 + (-0.72746293327402359783e-2 + (-0.48272489495730030780e-4 + (0.13661377309113939689e-5 + (-0.12302464447599382189e-7 + (0.16707760028737074907e-10 + (0.11672928324444444444e-11 - 0.20105801424709924499e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 67: {
-      double t = 2*y100 - 135;
-      return 0.46662374675511439448e0 + (-0.74517177649528487002e-2 + (-0.40369318744279128718e-4 + (0.12685621118898535407e-5 + (-0.12070791463315156250e-7 + (0.29105507892605823871e-10 + (0.90653314645333333334e-12 - 0.17189503312102982646e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 68: {
-      double t = 2*y100 - 137;
-      return 0.45156879030168268778e0 + (-0.75983560650033817497e-2 + (-0.33045110380705139759e-4 + (0.11732956732035040896e-5 + (-0.11729986947158201869e-7 + (0.38611905704166441308e-10 + (0.68468768305777777779e-12 - 0.14549134330396754575e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 69: {
-      double t = 2*y100 - 139;
-      return 0.43624909769330896904e0 + (-0.77168291040309554679e-2 + (-0.26283612321339907756e-4 + (0.10811018836893550820e-5 + (-0.11306707563739851552e-7 + (0.45670446788529607380e-10 + (0.49782492549333333334e-12 - 0.12191983967561779442e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 70: {
-      double t = 2*y100 - 141;
-      return 0.42071877443548481181e0 + (-0.78093484015052730097e-2 + (-0.20064596897224934705e-4 + (0.99254806680671890766e-6 + (-0.10823412088884741451e-7 + (0.50677203326904716247e-10 + (0.34200547594666666666e-12 - 0.10112698698356194618e-13 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 71: {
-      double t = 2*y100 - 143;
-      return 0.40502758809710844280e0 + (-0.78780384460872937555e-2 + (-0.14364940764532853112e-4 + (0.90803709228265217384e-6 + (-0.10298832847014466907e-7 + (0.53981671221969478551e-10 + (0.21342751381333333333e-12 - 0.82975901848387729274e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 72: {
-      double t = 2*y100 - 145;
-      return 0.38922115269731446690e0 + (-0.79249269708242064120e-2 + (-0.91595258799106970453e-5 + (0.82783535102217576495e-6 + (-0.97484311059617744437e-8 + (0.55889029041660225629e-10 + (0.10851981336888888889e-12 - 0.67278553237853459757e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 73: {
-      double t = 2*y100 - 147;
-      return 0.37334112915460307335e0 + (-0.79519385109223148791e-2 + (-0.44219833548840469752e-5 + (0.75209719038240314732e-6 + (-0.91848251458553190451e-8 + (0.56663266668051433844e-10 + (0.23995894257777777778e-13 - 0.53819475285389344313e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 74: {
-      double t = 2*y100 - 149;
-      return 0.35742543583374223085e0 + (-0.79608906571527956177e-2 + (-0.12530071050975781198e-6 + (0.68088605744900552505e-6 + (-0.86181844090844164075e-8 + (0.56530784203816176153e-10 + (-0.43120012248888888890e-13 - 0.42372603392496813810e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 75: {
-      double t = 2*y100 - 151;
-      return 0.34150846431979618536e0 + (-0.79534924968773806029e-2 + (0.37576885610891515813e-5 + (0.61419263633090524326e-6 + (-0.80565865409945960125e-8 + (0.55684175248749269411e-10 + (-0.95486860764444444445e-13 - 0.32712946432984510595e-14 * t) * t) * t) * t) * t) * t) * t;
-    }
-    case 76: {
-      double t = 2*y100 - 153;
-      return 0.32562129649136346824e0 + (-0.79313448067948884309e-2 + (0.72539159933545300034e-5 + (0.55195028297415503083e-6 + (-0.75063365335570475258e-8 + (0.54281686749699595941e-10 - 0.13545424295111111111e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 77: {
-      double t = 2*y100 - 155;
-      return 0.30979191977078391864e0 + (-0.78959416264207333695e-2 + (0.10389774377677210794e-4 + (0.49404804463196316464e-6 + (-0.69722488229411164685e-8 + (0.52469254655951393842e-10 - 0.16507860650666666667e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 78: {
-      double t = 2*y100 - 157;
-      return 0.29404543811214459904e0 + (-0.78486728990364155356e-2 + (0.13190885683106990459e-4 + (0.44034158861387909694e-6 + (-0.64578942561562616481e-8 + (0.50354306498006928984e-10 - 0.18614473550222222222e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 79: {
-      double t = 2*y100 - 159;
-      return 0.27840427686253660515e0 + (-0.77908279176252742013e-2 + (0.15681928798708548349e-4 + (0.39066226205099807573e-6 + (-0.59658144820660420814e-8 + (0.48030086420373141763e-10 - 0.20018995173333333333e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 80: {
-      double t = 2*y100 - 161;
-      return 0.26288838011163800908e0 + (-0.77235993576119469018e-2 + (0.17886516796198660969e-4 + (0.34482457073472497720e-6 + (-0.54977066551955420066e-8 + (0.45572749379147269213e-10 - 0.20852924954666666667e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 81: {
-      double t = 2*y100 - 163;
-      return 0.24751539954181029717e0 + (-0.76480877165290370975e-2 + (0.19827114835033977049e-4 + (0.30263228619976332110e-6 + (-0.50545814570120129947e-8 + (0.43043879374212005966e-10 - 0.21228012028444444444e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 82: {
-      double t = 2*y100 - 165;
-      return 0.23230087411688914593e0 + (-0.75653060136384041587e-2 + (0.21524991113020016415e-4 + (0.26388338542539382413e-6 + (-0.46368974069671446622e-8 + (0.40492715758206515307e-10 - 0.21238627815111111111e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 83: {
-      double t = 2*y100 - 167;
-      return 0.21725840021297341931e0 + (-0.74761846305979730439e-2 + (0.23000194404129495243e-4 + (0.22837400135642906796e-6 + (-0.42446743058417541277e-8 + (0.37958104071765923728e-10 - 0.20963978568888888889e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 84: {
-      double t = 2*y100 - 169;
-      return 0.20239979200788191491e0 + (-0.73815761980493466516e-2 + (0.24271552727631854013e-4 + (0.19590154043390012843e-6 + (-0.38775884642456551753e-8 + (0.35470192372162901168e-10 - 0.20470131678222222222e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 85: {
-      double t = 2*y100 - 171;
-      return 0.18773523211558098962e0 + (-0.72822604530339834448e-2 + (0.25356688567841293697e-4 + (0.16626710297744290016e-6 + (-0.35350521468015310830e-8 + (0.33051896213898864306e-10 - 0.19811844544000000000e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 86: {
-      double t = 2*y100 - 173;
-      return 0.17327341258479649442e0 + (-0.71789490089142761950e-2 + (0.26272046822383820476e-4 + (0.13927732375657362345e-6 + (-0.32162794266956859603e-8 + (0.30720156036105652035e-10 - 0.19034196304000000000e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 87: {
-      double t = 2*y100 - 175;
-      return 0.15902166648328672043e0 + (-0.70722899934245504034e-2 + (0.27032932310132226025e-4 + (0.11474573347816568279e-6 + (-0.29203404091754665063e-8 + (0.28487010262547971859e-10 - 0.18174029063111111111e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 88: {
-      double t = 2*y100 - 177;
-      return 0.14498609036610283865e0 + (-0.69628725220045029273e-2 + (0.27653554229160596221e-4 + (0.92493727167393036470e-7 + (-0.26462055548683583849e-8 + (0.26360506250989943739e-10 - 0.17261211260444444444e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 89: {
-      double t = 2*y100 - 179;
-      return 0.13117165798208050667e0 + (-0.68512309830281084723e-2 + (0.28147075431133863774e-4 + (0.72351212437979583441e-7 + (-0.23927816200314358570e-8 + (0.24345469651209833155e-10 - 0.16319736960000000000e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 90: {
-      double t = 2*y100 - 181;
-      return 0.11758232561160626306e0 + (-0.67378491192463392927e-2 + (0.28525664781722907847e-4 + (0.54156999310046790024e-7 + (-0.21589405340123827823e-8 + (0.22444150951727334619e-10 - 0.15368675584000000000e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 91: {
-      double t = 2*y100 - 183;
-      return 0.10422112945361673560e0 + (-0.66231638959845581564e-2 + (0.28800551216363918088e-4 + (0.37758983397952149613e-7 + (-0.19435423557038933431e-8 + (0.20656766125421362458e-10 - 0.14422990012444444444e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 92: {
-      double t = 2*y100 - 185;
-      return 0.91090275493541084785e-1 + (-0.65075691516115160062e-2 + (0.28982078385527224867e-4 + (0.23014165807643012781e-7 + (-0.17454532910249875958e-8 + (0.18981946442680092373e-10 - 0.13494234691555555556e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 93: {
-      double t = 2*y100 - 187;
-      return 0.78191222288771379358e-1 + (-0.63914190297303976434e-2 + (0.29079759021299682675e-4 + (0.97885458059415717014e-8 + (-0.15635596116134296819e-8 + (0.17417110744051331974e-10 - 0.12591151763555555556e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 94: {
-      double t = 2*y100 - 189;
-      return 0.65524757106147402224e-1 + (-0.62750311956082444159e-2 + (0.29102328354323449795e-4 + (-0.20430838882727954582e-8 + (-0.13967781903855367270e-8 + (0.15958771833747057569e-10 - 0.11720175765333333333e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 95: {
-      double t = 2*y100 - 191;
-      return 0.53091065838453612773e-1 + (-0.61586898417077043662e-2 + (0.29057796072960100710e-4 + (-0.12597414620517987536e-7 + (-0.12440642607426861943e-8 + (0.14602787128447932137e-10 - 0.10885859114666666667e-12 * t) * t) * t) * t) * t) * t;
-    }
-    case 96: {
-      double t = 2*y100 - 193;
-      return 0.40889797115352738582e-1 + (-0.60426484889413678200e-2 + (0.28953496450191694606e-4 + (-0.21982952021823718400e-7 + (-0.11044169117553026211e-8 + (0.13344562332430552171e-10 - 0.10091231402844444444e-12 * t) * t) * t) * t) * t) * t;
-    }
-  case 97: case 98:
-  case 99: case 100: { // use Taylor expansion for small x (|x| <= 0.0309...)
-      //  (2/sqrt(pi)) * (x - 2/3 x^3  + 4/15 x^5  - 8/105 x^7 + 16/945 x^9) 
-      double x2 = x*x;
-      return x * (1.1283791670955125739
-                  - x2 * (0.75225277806367504925
-                          - x2 * (0.30090111122547001970
-                                  - x2 * (0.085971746064420005629
-                                          - x2 * 0.016931216931216931217))));
-    }
-  }
-  /* Since 0 <= y100 < 101, this is only reached if x is NaN,
-     in which case we should return NaN. */
-  return NaN;
-}
-
-double FADDEEVA(w_im)(double x)
-{
-  if (x >= 0) {
-    if (x > 45) { // continued-fraction expansion is faster
-      const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
-      if (x > 5e7) // 1-term expansion, important to avoid overflow
-        return ispi / x;
-      /* 5-term expansion (rely on compiler for CSE), simplified from:
-                ispi / (x-0.5/(x-1/(x-1.5/(x-2/x))))  */
-      return ispi*((x*x) * (x*x-4.5) + 2) / (x * ((x*x) * (x*x-5) + 3.75));
-    }
-    return w_im_y100(100/(1+x), x);
-  }
-  else { // = -FADDEEVA(w_im)(-x)
-    if (x < -45) { // continued-fraction expansion is faster
-      const double ispi = 0.56418958354775628694807945156; // 1 / sqrt(pi)
-      if (x < -5e7) // 1-term expansion, important to avoid overflow
-        return ispi / x;
-      /* 5-term expansion (rely on compiler for CSE), simplified from:
-                ispi / (x-0.5/(x-1/(x-1.5/(x-2/x))))  */
-      return ispi*((x*x) * (x*x-4.5) + 2) / (x * ((x*x) * (x*x-5) + 3.75));
-    }
-    return -w_im_y100(100/(1-x), -x);
-  }
-}
-
-/////////////////////////////////////////////////////////////////////////
-
-// Compile with -DTEST_FADDEEVA to compile a little test program
-#ifdef TEST_FADDEEVA
-
-#ifdef __cplusplus
-#  include <cstdio>
-#else
-#  include <stdio.h>
-#endif
-
-// compute relative error |b-a|/|a|, handling case of NaN and Inf,
-static double relerr(double a, double b) {
-  if (isnan(a) || isnan(b) || isinf(a) || isinf(b)) {
-    if ((isnan(a) && !isnan(b)) || (!isnan(a) && isnan(b)) ||
-        (isinf(a) && !isinf(b)) || (!isinf(a) && isinf(b)) ||
-        (isinf(a) && isinf(b) && a*b < 0))
-      return Inf; // "infinite" error
-    return 0; // matching infinity/nan results counted as zero error
-  }
-  if (a == 0)
-    return b == 0 ? 0 : Inf;
-  else
-    return fabs((b-a) / a);
-}
-
-int main(void) {
-  double errmax_all = 0;
-  {
-    printf("############# w(z) tests #############\n");
-#define NTST 57 // define instead of const for C compatibility
-    cmplx z[NTST] = {
-      C(624.2,-0.26123),
-      C(-0.4,3.),
-      C(0.6,2.),
-      C(-1.,1.),
-      C(-1.,-9.),
-      C(-1.,9.),
-      C(-0.0000000234545,1.1234),
-      C(-3.,5.1),
-      C(-53,30.1),
-      C(0.0,0.12345),
-      C(11,1),
-      C(-22,-2),
-      C(9,-28),
-      C(21,-33),
-      C(1e5,1e5),
-      C(1e14,1e14),
-      C(-3001,-1000),
-      C(1e160,-1e159),
-      C(-6.01,0.01),
-      C(-0.7,-0.7),
-      C(2.611780000000000e+01, 4.540909610972489e+03),
-      C(0.8e7,0.3e7),
-      C(-20,-19.8081),
-      C(1e-16,-1.1e-16),
-      C(2.3e-8,1.3e-8),
-      C(6.3,-1e-13),
-      C(6.3,1e-20),
-      C(1e-20,6.3),
-      C(1e-20,16.3),
-      C(9,1e-300),
-      C(6.01,0.11),
-      C(8.01,1.01e-10),
-      C(28.01,1e-300),
-      C(10.01,1e-200),
-      C(10.01,-1e-200),
-      C(10.01,0.99e-10),
-      C(10.01,-0.99e-10),
-      C(1e-20,7.01),
-      C(-1,7.01),
-      C(5.99,7.01),
-      C(1,0),
-      C(55,0),
-      C(-0.1,0),
-      C(1e-20,0),
-      C(0,5e-14),
-      C(0,51),
-      C(Inf,0),
-      C(-Inf,0),
-      C(0,Inf),
-      C(0,-Inf),
-      C(Inf,Inf),
-      C(Inf,-Inf),
-      C(NaN,NaN),
-      C(NaN,0),
-      C(0,NaN),
-      C(NaN,Inf),
-      C(Inf,NaN)
-    };
-    cmplx w[NTST] = { /* w(z), computed with WolframAlpha
-                                   ... note that WolframAlpha is problematic
-                                   some of the above inputs, so I had to
-                                   use the continued-fraction expansion
-                                   in WolframAlpha in some cases, or switch
-                                   to Maple */
-      C(-3.78270245518980507452677445620103199303131110e-7,
-        0.000903861276433172057331093754199933411710053155),
-      C(0.1764906227004816847297495349730234591778719532788,
-        -0.02146550539468457616788719893991501311573031095617),
-      C(0.2410250715772692146133539023007113781272362309451,
-        0.06087579663428089745895459735240964093522265589350),
-      C(0.30474420525691259245713884106959496013413834051768,
-        -0.20821893820283162728743734725471561394145872072738),
-      C(7.317131068972378096865595229600561710140617977e34,
-        8.321873499714402777186848353320412813066170427e34),
-      C(0.0615698507236323685519612934241429530190806818395,
-        -0.00676005783716575013073036218018565206070072304635),
-      C(0.3960793007699874918961319170187598400134746631,
-        -5.593152259116644920546186222529802777409274656e-9),
-      C(0.08217199226739447943295069917990417630675021771804,
-        -0.04701291087643609891018366143118110965272615832184),
-      C(0.00457246000350281640952328010227885008541748668738,
-        -0.00804900791411691821818731763401840373998654987934),
-      C(0.8746342859608052666092782112565360755791467973338452,
-        0.),
-      C(0.00468190164965444174367477874864366058339647648741,
-        0.0510735563901306197993676329845149741675029197050),
-      C(-0.0023193175200187620902125853834909543869428763219,
-        -0.025460054739731556004902057663500272721780776336),
-      C(9.11463368405637174660562096516414499772662584e304,
-        3.97101807145263333769664875189354358563218932e305),
-      C(-4.4927207857715598976165541011143706155432296e281,
-        -2.8019591213423077494444700357168707775769028e281),
-      C(2.820947917809305132678577516325951485807107151e-6,
-        2.820947917668257736791638444590253942253354058e-6),
-      C(2.82094791773878143474039725787438662716372268e-15,
-        2.82094791773878143474039725773333923127678361e-15),
-      C(-0.0000563851289696244350147899376081488003110150498,
-        -0.000169211755126812174631861529808288295454992688),
-      C(-5.586035480670854326218608431294778077663867e-162,
-        5.586035480670854326218608431294778077663867e-161),
-      C(0.00016318325137140451888255634399123461580248456,
-        -0.095232456573009287370728788146686162555021209999),
-      C(0.69504753678406939989115375989939096800793577783885,
-        -1.8916411171103639136680830887017670616339912024317),
-      C(0.0001242418269653279656612334210746733213167234822,
-        7.145975826320186888508563111992099992116786763e-7),
-      C(2.318587329648353318615800865959225429377529825e-8,
-        6.182899545728857485721417893323317843200933380e-8),
-      C(-0.0133426877243506022053521927604277115767311800303,
-        -0.0148087097143220769493341484176979826888871576145),
-      C(1.00000000000000012412170838050638522857747934,
-        1.12837916709551279389615890312156495593616433e-16),
-      C(0.9999999853310704677583504063775310832036830015,
-        2.595272024519678881897196435157270184030360773e-8),
-      C(-1.4731421795638279504242963027196663601154624e-15,
-        0.090727659684127365236479098488823462473074709),
-      C(5.79246077884410284575834156425396800754409308e-18,
-        0.0907276596841273652364790985059772809093822374),
-      C(0.0884658993528521953466533278764830881245144368,
-        1.37088352495749125283269718778582613192166760e-22),
-      C(0.0345480845419190424370085249304184266813447878,
-        2.11161102895179044968099038990446187626075258e-23),
-      C(6.63967719958073440070225527042829242391918213e-36,
-        0.0630820900592582863713653132559743161572639353),
-      C(0.00179435233208702644891092397579091030658500743634,
-        0.0951983814805270647939647438459699953990788064762),
-      C(9.09760377102097999924241322094863528771095448e-13,
-        0.0709979210725138550986782242355007611074966717),
-      C(7.2049510279742166460047102593255688682910274423e-304,
-        0.0201552956479526953866611812593266285000876784321),
-      C(3.04543604652250734193622967873276113872279682e-44,
-        0.0566481651760675042930042117726713294607499165),
-      C(3.04543604652250734193622967873276113872279682e-44,
-        0.0566481651760675042930042117726713294607499165),
-      C(0.5659928732065273429286988428080855057102069081e-12,
-        0.056648165176067504292998527162143030538756683302),
-      C(-0.56599287320652734292869884280802459698927645e-12,
-        0.0566481651760675042929985271621430305387566833029),
-      C(0.0796884251721652215687859778119964009569455462,
-        1.11474461817561675017794941973556302717225126e-22),
-      C(0.07817195821247357458545539935996687005781943386550,
-        -0.01093913670103576690766705513142246633056714279654),
-      C(0.04670032980990449912809326141164730850466208439937,
-        0.03944038961933534137558064191650437353429669886545),
-      C(0.36787944117144232159552377016146086744581113103176,
-        0.60715770584139372911503823580074492116122092866515),
-      C(0,
-        0.010259688805536830986089913987516716056946786526145),
-      C(0.99004983374916805357390597718003655777207908125383,
-        -0.11208866436449538036721343053869621153527769495574),
-      C(0.99999999999999999999999999999999999999990000,
-        1.12837916709551257389615890312154517168802603e-20),
-      C(0.999999999999943581041645226871305192054749891144158,
-        0),
-      C(0.0110604154853277201542582159216317923453996211744250,
-        0),
-      C(0,0),
-      C(0,0),
-      C(0,0),
-      C(Inf,0),
-      C(0,0),
-      C(NaN,NaN),
-      C(NaN,NaN),
-      C(NaN,NaN),
-      C(NaN,0),
-      C(NaN,NaN),
-      C(NaN,NaN)
-    };
-    double errmax = 0;
-    for (int i = 0; i < NTST; ++i) {
-      cmplx fw = FADDEEVA(w)(z[i],0.);
-      double re_err = relerr(creal(w[i]), creal(fw));
-      double im_err = relerr(cimag(w[i]), cimag(fw));
-      printf("w(%g%+gi) = %g%+gi (vs. %g%+gi), re/im rel. err. = %0.2g/%0.2g)\n",
-             creal(z[i]),cimag(z[i]), creal(fw),cimag(fw), creal(w[i]),cimag(w[i]),
-             re_err, im_err);
-      if (re_err > errmax) errmax = re_err;
-      if (im_err > errmax) errmax = im_err;
-    }
-    if (errmax > 1e-13) {
-      printf("FAILURE -- relative error %g too large!\n", errmax);
-      return 1;
-    }
-    printf("SUCCESS (max relative error = %g)\n", errmax);
-    if (errmax > errmax_all) errmax_all = errmax;
-  }
-  {
-#undef NTST
-#define NTST 41 // define instead of const for C compatibility
-    cmplx z[NTST] = {
-      C(1,2),
-      C(-1,2),
-      C(1,-2),
-      C(-1,-2),
-      C(9,-28),
-      C(21,-33),
-      C(1e3,1e3),
-      C(-3001,-1000),
-      C(1e160,-1e159),
-      C(5.1e-3, 1e-8),
-      C(-4.9e-3, 4.95e-3),
-      C(4.9e-3, 0.5),
-      C(4.9e-4, -0.5e1),
-      C(-4.9e-5, -0.5e2),
-      C(5.1e-3, 0.5),
-      C(5.1e-4, -0.5e1),
-      C(-5.1e-5, -0.5e2),
-      C(1e-6,2e-6),
-      C(0,2e-6),
-      C(0,2),
-      C(0,20),
-      C(0,200),
-      C(Inf,0),
-      C(-Inf,0),
-      C(0,Inf),
-      C(0,-Inf),
-      C(Inf,Inf),
-      C(Inf,-Inf),
-      C(NaN,NaN),
-      C(NaN,0),
-      C(0,NaN),
-      C(NaN,Inf),
-      C(Inf,NaN),
-      C(1e-3,NaN),
-      C(7e-2,7e-2),
-      C(7e-2,-7e-4),
-      C(-9e-2,7e-4),
-      C(-9e-2,9e-2),
-      C(-7e-4,9e-2),
-      C(7e-2,0.9e-2),
-      C(7e-2,1.1e-2)
-    };
-    cmplx w[NTST] = { // erf(z[i]), evaluated with Maple
-      C(-0.5366435657785650339917955593141927494421,
-        -5.049143703447034669543036958614140565553),
-      C(0.5366435657785650339917955593141927494421,
-        -5.049143703447034669543036958614140565553),
-      C(-0.5366435657785650339917955593141927494421,
-        5.049143703447034669543036958614140565553),
-      C(0.5366435657785650339917955593141927494421,
-        5.049143703447034669543036958614140565553),
-      C(0.3359473673830576996788000505817956637777e304,
-        -0.1999896139679880888755589794455069208455e304),
-      C(0.3584459971462946066523939204836760283645e278,
-        0.3818954885257184373734213077678011282505e280),
-      C(0.9996020422657148639102150147542224526887,
-        0.00002801044116908227889681753993542916894856),
-      C(-1, 0),
-      C(1, 0),
-      C(0.005754683859034800134412990541076554934877,
-        0.1128349818335058741511924929801267822634e-7),
-      C(-0.005529149142341821193633460286828381876955,
-        0.005585388387864706679609092447916333443570),
-      C(0.007099365669981359632319829148438283865814,
-        0.6149347012854211635026981277569074001219),
-      C(0.3981176338702323417718189922039863062440e8,
-        -0.8298176341665249121085423917575122140650e10),
-      C(-Inf,
-        -Inf),
-      C(0.007389128308257135427153919483147229573895,
-        0.6149332524601658796226417164791221815139),
-      C(0.4143671923267934479245651547534414976991e8,
-        -0.8298168216818314211557046346850921446950e10),
-      C(-Inf,
-        -Inf),
-      C(0.1128379167099649964175513742247082845155e-5,
-        0.2256758334191777400570377193451519478895e-5),
-      C(0,
-        0.2256758334194034158904576117253481476197e-5),
-      C(0,
-        18.56480241457555259870429191324101719886),
-      C(0,
-        0.1474797539628786202447733153131835124599e173),
-      C(0,
-        Inf),
-      C(1,0),
-      C(-1,0),
-      C(0,Inf),
-      C(0,-Inf),
-      C(NaN,NaN),
-      C(NaN,NaN),
-      C(NaN,NaN),
-      C(NaN,0),
-      C(0,NaN),
-      C(NaN,NaN),
-      C(NaN,NaN),
-      C(NaN,NaN),
-      C(0.07924380404615782687930591956705225541145,
-        0.07872776218046681145537914954027729115247),
-      C(0.07885775828512276968931773651224684454495,
-        -0.0007860046704118224342390725280161272277506),
-      C(-0.1012806432747198859687963080684978759881,
-        0.0007834934747022035607566216654982820299469),
-      C(-0.1020998418798097910247132140051062512527,
-        0.1010030778892310851309082083238896270340),
-      C(-0.0007962891763147907785684591823889484764272,
-        0.1018289385936278171741809237435404896152),
-      C(0.07886408666470478681566329888615410479530,
-        0.01010604288780868961492224347707949372245),
-      C(0.07886723099940260286824654364807981336591,
-        0.01235199327873258197931147306290916629654)
-    };
-#define TST(f,isc)                                                      \
-    printf("############# " #f "(z) tests #############\n");            \
-    double errmax = 0;                                                  \
-    for (int i = 0; i < NTST; ++i) {                                    \
-      cmplx fw = FADDEEVA(f)(z[i],0.);                  \
-      double re_err = relerr(creal(w[i]), creal(fw));                   \
-      double im_err = relerr(cimag(w[i]), cimag(fw));                   \
-      printf(#f "(%g%+gi) = %g%+gi (vs. %g%+gi), re/im rel. err. = %0.2g/%0.2g)\n", \
-             creal(z[i]),cimag(z[i]), creal(fw),cimag(fw), creal(w[i]),cimag(w[i]), \
-             re_err, im_err);                                           \
-      if (re_err > errmax) errmax = re_err;                             \
-      if (im_err > errmax) errmax = im_err;                             \
-    }                                                                   \
-    if (errmax > 1e-13) {                                               \
-      printf("FAILURE -- relative error %g too large!\n", errmax);      \
-      return 1;                                                         \
-    }                                                                   \
-    printf("Checking " #f "(x) special case...\n");                     \
-    for (int i = 0; i < 10000; ++i) {                                   \
-      double x = pow(10., -300. + i * 600. / (10000 - 1));              \
-      double re_err = relerr(FADDEEVA_RE(f)(x),                         \
-                             creal(FADDEEVA(f)(C(x,x*isc),0.)));        \
-      if (re_err > errmax) errmax = re_err;                             \
-      re_err = relerr(FADDEEVA_RE(f)(-x),                               \
-                      creal(FADDEEVA(f)(C(-x,x*isc),0.)));              \
-      if (re_err > errmax) errmax = re_err;                             \
-    }                                                                   \
-    {                                                                   \
-      double re_err = relerr(FADDEEVA_RE(f)(Inf),                       \
-                             creal(FADDEEVA(f)(C(Inf,0.),0.))); \
-      if (re_err > errmax) errmax = re_err;                             \
-      re_err = relerr(FADDEEVA_RE(f)(-Inf),                             \
-                      creal(FADDEEVA(f)(C(-Inf,0.),0.)));               \
-      if (re_err > errmax) errmax = re_err;                             \
-      re_err = relerr(FADDEEVA_RE(f)(NaN),                              \
-                      creal(FADDEEVA(f)(C(NaN,0.),0.)));                \
-      if (re_err > errmax) errmax = re_err;                             \
-    }                                                                   \
-    if (errmax > 1e-13) {                                               \
-      printf("FAILURE -- relative error %g too large!\n", errmax);      \
-      return 1;                                                         \
-    }                                                                   \
-    printf("SUCCESS (max relative error = %g)\n", errmax);              \
-    if (errmax > errmax_all) errmax_all = errmax
-
-    TST(erf, 1e-20);
-  }
-  {
-    // since erfi just calls through to erf, just one test should
-    // be sufficient to make sure I didn't screw up the signs or something
-#undef NTST
-#define NTST 1 // define instead of const for C compatibility
-    cmplx z[NTST] = { C(1.234,0.5678) };
-    cmplx w[NTST] = { // erfi(z[i]), computed with Maple
-      C(1.081032284405373149432716643834106923212,
-        1.926775520840916645838949402886591180834)
-    };
-    TST(erfi, 0);
-  }
-  {
-    // since erfcx just calls through to w, just one test should
-    // be sufficient to make sure I didn't screw up the signs or something
-#undef NTST
-#define NTST 1 // define instead of const for C compatibility
-    cmplx z[NTST] = { C(1.234,0.5678) };
-    cmplx w[NTST] = { // erfcx(z[i]), computed with Maple
-      C(0.3382187479799972294747793561190487832579,
-        -0.1116077470811648467464927471872945833154)
-    };
-    TST(erfcx, 0);
-  }
-  {
-#undef NTST
-#define NTST 30 // define instead of const for C compatibility
-    cmplx z[NTST] = {
-      C(1,2),
-      C(-1,2),
-      C(1,-2),
-      C(-1,-2),
-      C(9,-28),
-      C(21,-33),
-      C(1e3,1e3),
-      C(-3001,-1000),
-      C(1e160,-1e159),
-      C(5.1e-3, 1e-8),
-      C(0,2e-6),
-      C(0,2),
-      C(0,20),
-      C(0,200),
-      C(2e-6,0),
-      C(2,0),
-      C(20,0),
-      C(200,0),
-      C(Inf,0),
-      C(-Inf,0),
-      C(0,Inf),
-      C(0,-Inf),
-      C(Inf,Inf),
-      C(Inf,-Inf),
-      C(NaN,NaN),
-      C(NaN,0),
-      C(0,NaN),
-      C(NaN,Inf),
-      C(Inf,NaN),
-      C(88,0)
-    };
-    cmplx w[NTST] = { // erfc(z[i]), evaluated with Maple
-      C(1.536643565778565033991795559314192749442,
-        5.049143703447034669543036958614140565553),
-      C(0.4633564342214349660082044406858072505579,
-        5.049143703447034669543036958614140565553),
-      C(1.536643565778565033991795559314192749442,
-        -5.049143703447034669543036958614140565553),
-      C(0.4633564342214349660082044406858072505579,
-        -5.049143703447034669543036958614140565553),
-      C(-0.3359473673830576996788000505817956637777e304,
-        0.1999896139679880888755589794455069208455e304),
-      C(-0.3584459971462946066523939204836760283645e278,
-        -0.3818954885257184373734213077678011282505e280),
-      C(0.0003979577342851360897849852457775473112748,
-        -0.00002801044116908227889681753993542916894856),
-      C(2, 0),
-      C(0, 0),
-      C(0.9942453161409651998655870094589234450651,
-        -0.1128349818335058741511924929801267822634e-7),
-      C(1,
-        -0.2256758334194034158904576117253481476197e-5),
-      C(1,
-        -18.56480241457555259870429191324101719886),
-      C(1,
-        -0.1474797539628786202447733153131835124599e173),
-      C(1, -Inf),
-      C(0.9999977432416658119838633199332831406314,
-        0),
-      C(0.004677734981047265837930743632747071389108,
-        0),
-      C(0.5395865611607900928934999167905345604088e-175,
-        0),
-      C(0, 0),
-      C(0, 0),
-      C(2, 0),
-      C(1, -Inf),
-      C(1, Inf),
-      C(NaN, NaN),
-      C(NaN, NaN),
-      C(NaN, NaN),
-      C(NaN, 0),
-      C(1, NaN),
-      C(NaN, NaN),
-      C(NaN, NaN),
-      C(0,0)
-    };
-    TST(erfc, 1e-20);
-  }
-  {
-#undef NTST
-#define NTST 48 // define instead of const for C compatibility
-    cmplx z[NTST] = {
-      C(2,1),
-      C(-2,1),
-      C(2,-1),
-      C(-2,-1),
-      C(-28,9),
-      C(33,-21),
-      C(1e3,1e3),
-      C(-1000,-3001),
-      C(1e-8, 5.1e-3),
-      C(4.95e-3, -4.9e-3),
-      C(5.1e-3, 5.1e-3),
-      C(0.5, 4.9e-3),
-      C(-0.5e1, 4.9e-4),
-      C(-0.5e2, -4.9e-5),
-      C(0.5e3, 4.9e-6),
-      C(0.5, 5.1e-3),
-      C(-0.5e1, 5.1e-4),
-      C(-0.5e2, -5.1e-5),
-      C(1e-6,2e-6),
-      C(2e-6,0),
-      C(2,0),
-      C(20,0),
-      C(200,0),
-      C(0,4.9e-3),
-      C(0,-5.1e-3),
-      C(0,2e-6),
-      C(0,-2),
-      C(0,20),
-      C(0,-200),
-      C(Inf,0),
-      C(-Inf,0),
-      C(0,Inf),
-      C(0,-Inf),
-      C(Inf,Inf),
-      C(Inf,-Inf),
-      C(NaN,NaN),
-      C(NaN,0),
-      C(0,NaN),
-      C(NaN,Inf),
-      C(Inf,NaN),
-      C(39, 6.4e-5),
-      C(41, 6.09e-5),
-      C(4.9e7, 5e-11),
-      C(5.1e7, 4.8e-11),
-      C(1e9, 2.4e-12),
-      C(1e11, 2.4e-14),
-      C(1e13, 2.4e-16),
-      C(1e300, 2.4e-303)
-    };
-    cmplx w[NTST] = { // dawson(z[i]), evaluated with Maple
-      C(0.1635394094345355614904345232875688576839,
-        -0.1531245755371229803585918112683241066853),
-      C(-0.1635394094345355614904345232875688576839,
-        -0.1531245755371229803585918112683241066853),
-      C(0.1635394094345355614904345232875688576839,
-        0.1531245755371229803585918112683241066853),
-      C(-0.1635394094345355614904345232875688576839,
-        0.1531245755371229803585918112683241066853),
-      C(-0.01619082256681596362895875232699626384420,
-        -0.005210224203359059109181555401330902819419),
-      C(0.01078377080978103125464543240346760257008,
-        0.006866888783433775382193630944275682670599),
-      C(-0.5808616819196736225612296471081337245459,
-        0.6688593905505562263387760667171706325749),
-      C(Inf,
-        -Inf),
-      C(0.1000052020902036118082966385855563526705e-7,
-        0.005100088434920073153418834680320146441685),
-      C(0.004950156837581592745389973960217444687524,
-        -0.004899838305155226382584756154100963570500),
-      C(0.005100176864319675957314822982399286703798,
-        0.005099823128319785355949825238269336481254),
-      C(0.4244534840871830045021143490355372016428,
-        0.002820278933186814021399602648373095266538),
-      C(-0.1021340733271046543881236523269967674156,
-        -0.00001045696456072005761498961861088944159916),
-      C(-0.01000200120119206748855061636187197886859,
-        0.9805885888237419500266621041508714123763e-8),
-      C(0.001000002000012000023960527532953151819595,
-        -0.9800058800588007290937355024646722133204e-11),
-      C(0.4244549085628511778373438768121222815752,
-        0.002935393851311701428647152230552122898291),
-      C(-0.1021340732357117208743299813648493928105,
-        -0.00001088377943049851799938998805451564893540),
-      C(-0.01000200120119126652710792390331206563616,
-        0.1020612612857282306892368985525393707486e-7),
-      C(0.1000000000007333333333344266666666664457e-5,
-        0.2000000000001333333333323199999999978819e-5),
-      C(0.1999999999994666666666675199999999990248e-5,
-        0),
-      C(0.3013403889237919660346644392864226952119,
-        0),
-      C(0.02503136792640367194699495234782353186858,
-        0),
-      C(0.002500031251171948248596912483183760683918,
-        0),
-      C(0,0.004900078433419939164774792850907128053308),
-      C(0,-0.005100088434920074173454208832365950009419),
-      C(0,0.2000000000005333333333341866666666676419e-5),
-      C(0,-48.16001211429122974789822893525016528191),
-      C(0,0.4627407029504443513654142715903005954668e174),
-      C(0,-Inf),
-      C(0,0),
-      C(-0,0),
-      C(0, Inf),
-      C(0, -Inf),
-      C(NaN, NaN),
-      C(NaN, NaN),
-      C(NaN, NaN),
-      C(NaN, 0),
-      C(0, NaN),
-      C(NaN, NaN),
-      C(NaN, NaN),
-      C(0.01282473148489433743567240624939698290584,
-        -0.2105957276516618621447832572909153498104e-7),
-      C(0.01219875253423634378984109995893708152885,
-        -0.1813040560401824664088425926165834355953e-7),
-      C(0.1020408163265306334945473399689037886997e-7,
-        -0.1041232819658476285651490827866174985330e-25),
-      C(0.9803921568627452865036825956835185367356e-8,
-        -0.9227220299884665067601095648451913375754e-26),
-      C(0.5000000000000000002500000000000000003750e-9,
-        -0.1200000000000000001800000188712838420241e-29),
-      C(5.00000000000000000000025000000000000000000003e-12,
-        -1.20000000000000000000018000000000000000000004e-36),
-      C(5.00000000000000000000000002500000000000000000e-14,
-        -1.20000000000000000000000001800000000000000000e-42),
-      C(5e-301, 0)
-    };
-    TST(Dawson, 1e-20);
-  }
-  printf("#####################################\n");
-  printf("SUCCESS (max relative error = %g)\n", errmax_all);
-}
-
-#endif

Faddeeva/Faddeeva.h

@@ -1,68 +0,0 @@
-/* Copyright (c) 2012 Massachusetts Institute of Technology
- * 
- * Permission is hereby granted, free of charge, to any person obtaining
- * a copy of this software and associated documentation files (the
- * "Software"), to deal in the Software without restriction, including
- * without limitation the rights to use, copy, modify, merge, publish,
- * distribute, sublicense, and/or sell copies of the Software, and to
- * permit persons to whom the Software is furnished to do so, subject to
- * the following conditions:
- * 
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- * 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
- * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
- * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
- * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 
- */
-
-/* Available at: http://ab-initio.mit.edu/Faddeeva
-
-   Header file for Faddeeva.c; see Faddeeva.cc for more information. */
-
-#ifndef FADDEEVA_H
-#define FADDEEVA_H 1
-
-// Require C99 complex-number support
-#include <complex.h>
-
-#ifdef __cplusplus
-extern "C"
-{
-#endif /* __cplusplus */
-
-// compute w(z) = exp(-z^2) erfc(-iz) [ Faddeeva / scaled complex error func ]
-extern double complex Faddeeva_w(double complex z,double relerr);
-extern double Faddeeva_w_im(double x); // special-case code for Im[w(x)] of real x
-
-// Various functions that we can compute with the help of w(z)
-
-// compute erfcx(z) = exp(z^2) erfc(z)
-extern double complex Faddeeva_erfcx(double complex z, double relerr);
-extern double Faddeeva_erfcx_re(double x); // special case for real x
-
-// compute erf(z), the error function of complex arguments
-extern double complex Faddeeva_erf(double complex z, double relerr);
-extern double Faddeeva_erf_re(double x); // special case for real x
-
-// compute erfi(z) = -i erf(iz), the imaginary error function
-extern double complex Faddeeva_erfi(double complex z, double relerr);
-extern double Faddeeva_erfi_re(double x); // special case for real x
-
-// compute erfc(z) = 1 - erf(z), the complementary error function
-extern double complex Faddeeva_erfc(double complex z, double relerr);
-extern double Faddeeva_erfc_re(double x); // special case for real x
-
-// compute Dawson(z) = sqrt(pi)/2  *  exp(-z^2) * erfi(z)
-extern double complex Faddeeva_Dawson(double complex z, double relerr);
-extern double Faddeeva_Dawson_re(double x); // special case for real x
-
-#ifdef __cplusplus
-}
-#endif /* __cplusplus */
-
-#endif // FADDEEVA_H

Faddeeva/Make.files

@@ -1,3 +0,0 @@
-# complex error functions from the Faddeeva package
-# (http://ab-initio.mit.edu/Faddeeva)
-$(CUR_SRCS) += Faddeeva.c

Make.inc

@@ -44,9 +44,6 @@ default: all
 %.S.o: %.S
 	$(CC) $(SFLAGS) $(filter -m% -B% -I% -D%,$(CFLAGS_add)) -c $< -o $@
 
-clean:
-	rm -fr *.o *.c.o *.S.o *~ test-double test-float test-double-system test-float-system *.dSYM
-
 # OS-specific stuff
 ifeq ($(ARCH),i386)
 override ARCH := i387

Makefile

@@ -28,6 +28,9 @@ libopenlibm.a: $(OBJS)
 libopenlibm.$(SHLIB_EXT): $(OBJS)
 	$(FC) -shared $(OBJS) $(LDFLAGS) -o libopenlibm.$(SHLIB_EXT)
 
+clean:
+	rm -fr {./,*}/*{.o,~}
+
 distclean:
 	rm -f $(OBJS) *.a *.$(SHLIB_EXT)
 	$(MAKE) -C test clean

amos/.gitignore

@@ -1,3 +0,0 @@
-*.o
-/libamos.dylib
-/libamos.so

amos/Make.files

@@ -1,5 +0,0 @@
-$(CUR_SRCS) +=  d1mach.f zabs.f   zasyi.f  zbesk.f  zbknu.f  zexp.f   zmlt.f   zshch.f  zuni1.f  zunk2.f \
-	dgamln.f zacai.f  zbesh.f  zbesy.f  zbuni.f  zkscl.f  zrati.f  zsqrt.f  zuni2.f  zuoik.f \
-	i1mach.f zacon.f  zbesi.f  zbinu.f  zbunk.f  zlog.f   zs1s2.f  zuchk.f  zunik.f  zwrsk.f \
-	xerror.f zairy.f  zbesj.f  zbiry.f  zdiv.f   zmlri.f  zseri.f  zunhj.f  zunk1.f
-

amos/d1mach.f

@@ -1,97 +0,0 @@
-*DECK D1MACH
-      DOUBLE PRECISION FUNCTION D1MACH(I)
-C***BEGIN PROLOGUE  D1MACH
-C***DATE WRITTEN   750101   (YYMMDD)
-C***REVISION DATE  890213   (YYMMDD)
-C***CATEGORY NO.  R1
-C***KEYWORDS  LIBRARY=SLATEC,TYPE=DOUBLE PRECISION(R1MACH-S D1MACH-D),
-C             MACHINE CONSTANTS
-C***AUTHOR  FOX, P. A., (BELL LABS)
-C           HALL, A. D., (BELL LABS)
-C           SCHRYER, N. L., (BELL LABS)
-C***PURPOSE  Returns double precision machine dependent constants
-C***DESCRIPTION
-C
-C   D1MACH can be used to obtain machine-dependent parameters
-C   for the local machine environment.  It is a function
-C   subprogram with one (input) argument, and can be called
-C   as follows, for example
-C
-C        D = D1MACH(I)
-C
-C   where I=1,...,5.  The (output) value of D above is
-C   determined by the (input) value of I.  The results for
-C   various values of I are discussed below.
-C
-C   D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude.
-C   D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
-C   D1MACH( 3) = B**(-T), the smallest relative spacing.
-C   D1MACH( 4) = B**(1-T), the largest relative spacing.
-C   D1MACH( 5) = LOG10(B)
-C
-C   Assume double precision numbers are represented in the T-digit,
-C   base-B form
-C
-C              sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
-C
-C   where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and
-C   EMIN .LE. E .LE. EMAX.
-C
-C   The values of B, T, EMIN and EMAX are provided in I1MACH as
-C   follows:
-C   I1MACH(10) = B, the base.
-C   I1MACH(14) = T, the number of base-B digits.
-C   I1MACH(15) = EMIN, the smallest exponent E.
-C   I1MACH(16) = EMAX, the largest exponent E.
-C
-C   To alter this function for a particular environment,
-C   the desired set of DATA statements should be activated by
-C   removing the C from column 1.  Also, the values of
-C   D1MACH(1) - D1MACH(4) should be checked for consistency
-C   with the local operating system.
-C
-C***REFERENCES  FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A
-C                 PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL
-C                 SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188.
-C***ROUTINES CALLED  XERROR
-C***END PROLOGUE  D1MACH
-C
-      INTEGER SMALL(4)
-      INTEGER LARGE(4)
-      INTEGER RIGHT(4)
-      INTEGER DIVER(4)
-      INTEGER LOG10(4)
-C
-      DOUBLE PRECISION DMACH(5)
-      SAVE DMACH
-C
-C      EQUIVALENCE (DMACH(1),SMALL(1))
-C      EQUIVALENCE (DMACH(2),LARGE(1))
-C      EQUIVALENCE (DMACH(3),RIGHT(1))
-C      EQUIVALENCE (DMACH(4),DIVER(1))
-C      EQUIVALENCE (DMACH(5),LOG10(1))
-C
-C     MACHINE CONSTANTS FOR THE IBM PC
-C     ASSUMES THAT ALL ARITHMETIC IS DONE IN DOUBLE PRECISION
-C     ON 8088, I.E., NOT IN 80 BIT FORM FOR THE 8087.
-C
-      DATA DMACH(1) / 2.23D-308 /
-C      DATA SMALL(1),SMALL(2) /  2002288515,    1050897 /
-      DATA DMACH(2) / 1.79D-308 /
-C      DATA LARGE(1),LARGE(2) /  1487780761, 2146426097 /
-      DATA DMACH(3) / 1.11D-16 /
-C      DATA RIGHT(1),RIGHT(2) / -1209488034, 1017118298 /
-      DATA DMACH(4) / 2.22D-16 /
-C      DATA DIVER(1),DIVER(2) / -1209488034, 1018166874 /
-      DATA DMACH(5) / 0.3010299956639812 /
-C      DATA LOG10(1),LOG10(2) /  1352628735, 1070810131 /
-C
-C
-C***FIRST EXECUTABLE STATEMENT  D1MACH
-      IF (I .LT. 1  .OR.  I .GT. 5)
-     1   CALL XERROR ('D1MACH -- I OUT OF BOUNDS', 25, 1, 2)
-C
-      D1MACH = DMACH(I)
-      RETURN
-C
-      END

amos/dgamln.f

@@ -1,189 +0,0 @@
-      DOUBLE PRECISION FUNCTION DGAMLN(Z,IERR)
-C***BEGIN PROLOGUE  DGAMLN
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  830501   (YYMMDD)
-C***CATEGORY NO.  B5F
-C***KEYWORDS  GAMMA FUNCTION,LOGARITHM OF GAMMA FUNCTION
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE THE LOGARITHM OF THE GAMMA FUNCTION
-C***DESCRIPTION
-C
-C               **** A DOUBLE PRECISION ROUTINE ****
-C         DGAMLN COMPUTES THE NATURAL LOG OF THE GAMMA FUNCTION FOR
-C         Z.GT.0.  THE ASYMPTOTIC EXPANSION IS USED TO GENERATE VALUES
-C         GREATER THAN ZMIN WHICH ARE ADJUSTED BY THE RECURSION
-C         G(Z+1)=Z*G(Z) FOR Z.LE.ZMIN.  THE FUNCTION WAS MADE AS
-C         PORTABLE AS POSSIBLE BY COMPUTIMG ZMIN FROM THE NUMBER OF BASE
-C         10 DIGITS IN A WORD, RLN=AMAX1(-ALOG10(R1MACH(4)),0.5E-18)
-C         LIMITED TO 18 DIGITS OF (RELATIVE) ACCURACY.
-C
-C         SINCE INTEGER ARGUMENTS ARE COMMON, A TABLE LOOK UP ON 100
-C         VALUES IS USED FOR SPEED OF EXECUTION.
-C
-C     DESCRIPTION OF ARGUMENTS
-C
-C         INPUT      Z IS D0UBLE PRECISION
-C           Z      - ARGUMENT, Z.GT.0.0D0
-C
-C         OUTPUT      DGAMLN IS DOUBLE PRECISION
-C           DGAMLN  - NATURAL LOG OF THE GAMMA FUNCTION AT Z.NE.0.0D0
-C           IERR    - ERROR FLAG
-C                     IERR=0, NORMAL RETURN, COMPUTATION COMPLETED
-C                     IERR=1, Z.LE.0.0D0,    NO COMPUTATION
-C
-C
-C***REFERENCES  COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 BY D. E. AMOS, SAND83-0083, MAY, 1983.
-C***ROUTINES CALLED  I1MACH,D1MACH
-C***END PROLOGUE  DGAMLN
-      DOUBLE PRECISION CF, CON, FLN, FZ, GLN, RLN, S, TLG, TRM, TST,
-     * T1, WDTOL, Z, ZDMY, ZINC, ZM, ZMIN, ZP, ZSQ, D1MACH
-      INTEGER I, IERR, I1M, K, MZ, NZ, I1MACH
-      DIMENSION CF(22), GLN(100)
-C           LNGAMMA(N), N=1,100
-      DATA GLN(1), GLN(2), GLN(3), GLN(4), GLN(5), GLN(6), GLN(7),
-     1     GLN(8), GLN(9), GLN(10), GLN(11), GLN(12), GLN(13), GLN(14),
-     2     GLN(15), GLN(16), GLN(17), GLN(18), GLN(19), GLN(20),
-     3     GLN(21), GLN(22)/
-     4     0.00000000000000000D+00,     0.00000000000000000D+00,
-     5     6.93147180559945309D-01,     1.79175946922805500D+00,
-     6     3.17805383034794562D+00,     4.78749174278204599D+00,
-     7     6.57925121201010100D+00,     8.52516136106541430D+00,
-     8     1.06046029027452502D+01,     1.28018274800814696D+01,
-     9     1.51044125730755153D+01,     1.75023078458738858D+01,
-     A     1.99872144956618861D+01,     2.25521638531234229D+01,
-     B     2.51912211827386815D+01,     2.78992713838408916D+01,
-     C     3.06718601060806728D+01,     3.35050734501368889D+01,
-     D     3.63954452080330536D+01,     3.93398841871994940D+01,
-     E     4.23356164607534850D+01,     4.53801388984769080D+01/
-      DATA GLN(23), GLN(24), GLN(25), GLN(26), GLN(27), GLN(28),
-     1     GLN(29), GLN(30), GLN(31), GLN(32), GLN(33), GLN(34),
-     2     GLN(35), GLN(36), GLN(37), GLN(38), GLN(39), GLN(40),
-     3     GLN(41), GLN(42), GLN(43), GLN(44)/
-     4     4.84711813518352239D+01,     5.16066755677643736D+01,
-     5     5.47847293981123192D+01,     5.80036052229805199D+01,
-     6     6.12617017610020020D+01,     6.45575386270063311D+01,
-     7     6.78897431371815350D+01,     7.12570389671680090D+01,
-     8     7.46582363488301644D+01,     7.80922235533153106D+01,
-     9     8.15579594561150372D+01,     8.50544670175815174D+01,
-     A     8.85808275421976788D+01,     9.21361756036870925D+01,
-     B     9.57196945421432025D+01,     9.93306124547874269D+01,
-     C     1.02968198614513813D+02,     1.06631760260643459D+02,
-     D     1.10320639714757395D+02,     1.14034211781461703D+02,
-     E     1.17771881399745072D+02,     1.21533081515438634D+02/
-      DATA GLN(45), GLN(46), GLN(47), GLN(48), GLN(49), GLN(50),
-     1     GLN(51), GLN(52), GLN(53), GLN(54), GLN(55), GLN(56),
-     2     GLN(57), GLN(58), GLN(59), GLN(60), GLN(61), GLN(62),
-     3     GLN(63), GLN(64), GLN(65), GLN(66)/
-     4     1.25317271149356895D+02,     1.29123933639127215D+02,
-     5     1.32952575035616310D+02,     1.36802722637326368D+02,
-     6     1.40673923648234259D+02,     1.44565743946344886D+02,
-     7     1.48477766951773032D+02,     1.52409592584497358D+02,
-     8     1.56360836303078785D+02,     1.60331128216630907D+02,
-     9     1.64320112263195181D+02,     1.68327445448427652D+02,
-     A     1.72352797139162802D+02,     1.76395848406997352D+02,
-     B     1.80456291417543771D+02,     1.84533828861449491D+02,
-     C     1.88628173423671591D+02,     1.92739047287844902D+02,
-     D     1.96866181672889994D+02,     2.01009316399281527D+02,
-     E     2.05168199482641199D+02,     2.09342586752536836D+02/
-      DATA GLN(67), GLN(68), GLN(69), GLN(70), GLN(71), GLN(72),
-     1     GLN(73), GLN(74), GLN(75), GLN(76), GLN(77), GLN(78),
-     2     GLN(79), GLN(80), GLN(81), GLN(82), GLN(83), GLN(84),
-     3     GLN(85), GLN(86), GLN(87), GLN(88)/
-     4     2.13532241494563261D+02,     2.17736934113954227D+02,
-     5     2.21956441819130334D+02,     2.26190548323727593D+02,
-     6     2.30439043565776952D+02,     2.34701723442818268D+02,
-     7     2.38978389561834323D+02,     2.43268849002982714D+02,
-     8     2.47572914096186884D+02,     2.51890402209723194D+02,
-     9     2.56221135550009525D+02,     2.60564940971863209D+02,
-     A     2.64921649798552801D+02,     2.69291097651019823D+02,
-     B     2.73673124285693704D+02,     2.78067573440366143D+02,
-     C     2.82474292687630396D+02,     2.86893133295426994D+02,
-     D     2.91323950094270308D+02,     2.95766601350760624D+02,
-     E     3.00220948647014132D+02,     3.04686856765668715D+02/
-      DATA GLN(89), GLN(90), GLN(91), GLN(92), GLN(93), GLN(94),
-     1     GLN(95), GLN(96), GLN(97), GLN(98), GLN(99), GLN(100)/
-     2     3.09164193580146922D+02,     3.13652829949879062D+02,
-     3     3.18152639620209327D+02,     3.22663499126726177D+02,
-     4     3.27185287703775217D+02,     3.31717887196928473D+02,
-     5     3.36261181979198477D+02,     3.40815058870799018D+02,
-     6     3.45379407062266854D+02,     3.49954118040770237D+02,
-     7     3.54539085519440809D+02,     3.59134205369575399D+02/
-C             COEFFICIENTS OF ASYMPTOTIC EXPANSION
-      DATA CF(1), CF(2), CF(3), CF(4), CF(5), CF(6), CF(7), CF(8),
-     1     CF(9), CF(10), CF(11), CF(12), CF(13), CF(14), CF(15),
-     2     CF(16), CF(17), CF(18), CF(19), CF(20), CF(21), CF(22)/
-     3     8.33333333333333333D-02,    -2.77777777777777778D-03,
-     4     7.93650793650793651D-04,    -5.95238095238095238D-04,
-     5     8.41750841750841751D-04,    -1.91752691752691753D-03,
-     6     6.41025641025641026D-03,    -2.95506535947712418D-02,
-     7     1.79644372368830573D-01,    -1.39243221690590112D+00,
-     8     1.34028640441683920D+01,    -1.56848284626002017D+02,
-     9     2.19310333333333333D+03,    -3.61087712537249894D+04,
-     A     6.91472268851313067D+05,    -1.52382215394074162D+07,
-     B     3.82900751391414141D+08,    -1.08822660357843911D+10,
-     C     3.47320283765002252D+11,    -1.23696021422692745D+13,
-     D     4.88788064793079335D+14,    -2.13203339609193739D+16/
-C
-C             LN(2*PI)
-      DATA CON                    /     1.83787706640934548D+00/
-C
-C***FIRST EXECUTABLE STATEMENT  DGAMLN
-      IERR=0
-      IF (Z.LE.0.0D0) GO TO 70
-      IF (Z.GT.101.0D0) GO TO 10
-      NZ = INT(SNGL(Z))
-      FZ = Z - FLOAT(NZ)
-      IF (FZ.GT.0.0D0) GO TO 10
-      IF (NZ.GT.100) GO TO 10
-      DGAMLN = GLN(NZ)
-      RETURN
-   10 CONTINUE
-      WDTOL = D1MACH(4)
-      WDTOL = DMAX1(WDTOL,0.5D-18)
-      I1M = I1MACH(14)
-      RLN = D1MACH(5)*FLOAT(I1M)
-      FLN = DMIN1(RLN,20.0D0)
-      FLN = DMAX1(FLN,3.0D0)
-      FLN = FLN - 3.0D0
-      ZM = 1.8000D0 + 0.3875D0*FLN
-      MZ = INT(SNGL(ZM)) + 1
-      ZMIN = FLOAT(MZ)
-      ZDMY = Z
-      ZINC = 0.0D0
-      IF (Z.GE.ZMIN) GO TO 20
-      ZINC = ZMIN - FLOAT(NZ)
-      ZDMY = Z + ZINC
-   20 CONTINUE
-      ZP = 1.0D0/ZDMY
-      T1 = CF(1)*ZP
-      S = T1
-      IF (ZP.LT.WDTOL) GO TO 40
-      ZSQ = ZP*ZP
-      TST = T1*WDTOL
-      DO 30 K=2,22
-        ZP = ZP*ZSQ
-        TRM = CF(K)*ZP
-        IF (DABS(TRM).LT.TST) GO TO 40
-        S = S + TRM
-   30 CONTINUE
-   40 CONTINUE
-      IF (ZINC.NE.0.0D0) GO TO 50
-      TLG = DLOG(Z)
-      DGAMLN = Z*(TLG-1.0D0) + 0.5D0*(CON-TLG) + S
-      RETURN
-   50 CONTINUE
-      ZP = 1.0D0
-      NZ = INT(SNGL(ZINC))
-      DO 60 I=1,NZ
-        ZP = ZP*(Z+FLOAT(I-1))
-   60 CONTINUE
-      TLG = DLOG(ZDMY)
-      DGAMLN = ZDMY*(TLG-1.0D0) - DLOG(ZP) + 0.5D0*(CON-TLG) + S
-      RETURN
-C
-C
-   70 CONTINUE
-      IERR=1
-      RETURN
-      END

amos/i1mach.f

@@ -1,113 +0,0 @@
-*DECK I1MACH
-      INTEGER FUNCTION I1MACH(I)
-C***BEGIN PROLOGUE  I1MACH
-C***DATE WRITTEN   750101   (YYMMDD)
-C***REVISION DATE  890213   (YYMMDD)
-C***CATEGORY NO.  R1
-C***KEYWORDS  LIBRARY=SLATEC,TYPE=INTEGER(I1MACH-I),MACHINE CONSTANTS
-C***AUTHOR  FOX, P. A., (BELL LABS)
-C           HALL, A. D., (BELL LABS)
-C           SCHRYER, N. L., (BELL LABS)
-C***PURPOSE  Returns integer machine dependent constants
-C***DESCRIPTION
-C
-C     I1MACH can be used to obtain machine-dependent parameters
-C     for the local machine environment.  It is a function
-C     subroutine with one (input) argument, and can be called
-C     as follows, for example
-C
-C          K = I1MACH(I)
-C
-C     where I=1,...,16.  The (output) value of K above is
-C     determined by the (input) value of I.  The results for
-C     various values of I are discussed below.
-C
-C  I/O unit numbers.
-C    I1MACH( 1) = the standard input unit.
-C    I1MACH( 2) = the standard output unit.
-C    I1MACH( 3) = the standard punch unit.
-C    I1MACH( 4) = the standard error message unit.
-C
-C  Words.
-C    I1MACH( 5) = the number of bits per integer storage unit.
-C    I1MACH( 6) = the number of characters per integer storage unit.
-C
-C  Integers.
-C    assume integers are represented in the S-digit, base-A form
-C
-C               sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
-C
-C               where 0 .LE. X(I) .LT. A for I=0,...,S-1.
-C    I1MACH( 7) = A, the base.
-C    I1MACH( 8) = S, the number of base-A digits.
-C    I1MACH( 9) = A**S - 1, the largest magnitude.
-C
-C  Floating-Point Numbers.
-C    Assume floating-point numbers are represented in the T-digit,
-C    base-B form
-C               sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
-C
-C               where 0 .LE. X(I) .LT. B for I=1,...,T,
-C               0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
-C    I1MACH(10) = B, the base.
-C
-C  Single-Precision
-C    I1MACH(11) = T, the number of base-B digits.
-C    I1MACH(12) = EMIN, the smallest exponent E.
-C    I1MACH(13) = EMAX, the largest exponent E.
-C
-C  Double-Precision
-C    I1MACH(14) = T, the number of base-B digits.
-C    I1MACH(15) = EMIN, the smallest exponent E.
-C    I1MACH(16) = EMAX, the largest exponent E.
-C
-C  To alter this function for a particular environment,
-C  the desired set of DATA statements should be activated by
-C  removing the C from column 1.  Also, the values of
-C  I1MACH(1) - I1MACH(4) should be checked for consistency
-C  with the local operating system.
-C
-C***REFERENCES  FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A
-C                 PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL
-C                 SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188.
-C***ROUTINES CALLED  (NONE)
-C***END PROLOGUE  I1MACH
-C
-      INTEGER IMACH(16),OUTPUT
-      SAVE IMACH
-      EQUIVALENCE (IMACH(4),OUTPUT)
-C
-C     MACHINE CONSTANTS FOR THE IBM PC
-C
-      DATA IMACH( 1) /     5 /
-      DATA IMACH( 2) /     6 /
-      DATA IMACH( 3) /     0 /
-      DATA IMACH( 4) /     0 /
-      DATA IMACH( 5) /    32 /
-      DATA IMACH( 6) /     4 /
-      DATA IMACH( 7) /     2 /
-      DATA IMACH( 8) /    31 /
-      DATA IMACH( 9) / 2147483647 /
-      DATA IMACH(10) /     2 /
-      DATA IMACH(11) /    24 /
-      DATA IMACH(12) /  -125 /
-      DATA IMACH(13) /   127 /
-      DATA IMACH(14) /    53 /
-      DATA IMACH(15) / -1021 /
-      DATA IMACH(16) /  1023 /
-C
-C***FIRST EXECUTABLE STATEMENT  I1MACH
-      IF (I .LT. 1  .OR.  I .GT. 16) GO TO 10
-C
-      I1MACH = IMACH(I)
-      RETURN
-C
-   10 CONTINUE
-      WRITE (UNIT = OUTPUT, FMT = 9000)
- 9000 FORMAT ('1ERROR    1 IN I1MACH - I OUT OF BOUNDS')
-C
-C     CALL FDUMP
-C
-C
-      STOP
-      END

amos/xerror.f

@@ -1,22 +0,0 @@
-      SUBROUTINE XERROR(MESS,NMESS,L1,L2)
-C
-C     THIS IS A DUMMY XERROR ROUTINE TO PRINT ERROR MESSAGES WITH NMESS
-C     CHARACTERS. L1 AND L2 ARE DUMMY PARAMETERS TO MAKE THIS CALL
-C     COMPATIBLE WITH THE SLATEC XERROR ROUTINE. THIS IS A FORTRAN 77
-C     ROUTINE.
-C
-      CHARACTER*(*) MESS
-      NN=NMESS/70
-      NR=NMESS-70*NN
-      IF(NR.NE.0) NN=NN+1
-      K=1
-      PRINT 900
-  900 FORMAT(/)
-      DO 10 I=1,NN
-        KMIN=MIN0(K+69,NMESS)
-        PRINT *, MESS(K:KMIN)
-        K=K+70
-   10 CONTINUE
-      PRINT 900
-      RETURN
-      END

amos/zabs.f

@@ -1,29 +0,0 @@
-      DOUBLE PRECISION FUNCTION ZABS(ZR, ZI)
-C***BEGIN PROLOGUE  ZABS
-C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY
-C
-C     ZABS COMPUTES THE ABSOLUTE VALUE OR MAGNITUDE OF A DOUBLE
-C     PRECISION COMPLEX VARIABLE CMPLX(ZR,ZI)
-C
-C***ROUTINES CALLED  (NONE)
-C***END PROLOGUE  ZABS
-      DOUBLE PRECISION ZR, ZI, U, V, Q, S
-      U = DABS(ZR)
-      V = DABS(ZI)
-      S = U + V
-C-----------------------------------------------------------------------
-C     S*1.0D0 MAKES AN UNNORMALIZED UNDERFLOW ON CDC MACHINES INTO A
-C     TRUE FLOATING ZERO
-C-----------------------------------------------------------------------
-      S = S*1.0D+0
-      IF (S.EQ.0.0D+0) GO TO 20
-      IF (U.GT.V) GO TO 10
-      Q = U/V
-      ZABS = V*DSQRT(1.D+0+Q*Q)
-      RETURN
-   10 Q = V/U
-      ZABS = U*DSQRT(1.D+0+Q*Q)
-      RETURN
-   20 ZABS = 0.0D+0
-      RETURN
-      END

amos/zacai.f

@@ -1,99 +0,0 @@
-      SUBROUTINE ZACAI(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, TOL,
-     * ELIM, ALIM)
-C***BEGIN PROLOGUE  ZACAI
-C***REFER TO  ZAIRY
-C
-C     ZACAI APPLIES THE ANALYTIC CONTINUATION FORMULA
-C
-C         K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN)
-C                 MP=PI*MR*CMPLX(0.0,1.0)
-C
-C     TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT
-C     HALF Z PLANE FOR USE WITH ZAIRY WHERE FNU=1/3 OR 2/3 AND N=1.
-C     ZACAI IS THE SAME AS ZACON WITH THE PARTS FOR LARGER ORDERS AND
-C     RECURRENCE REMOVED. A RECURSIVE CALL TO ZACON CAN RESULT IF ZACON
-C     IS CALLED FROM ZAIRY.
-C
-C***ROUTINES CALLED  ZASYI,ZBKNU,ZMLRI,ZSERI,ZS1S2,D1MACH,ZABS
-C***END PROLOGUE  ZACAI
-C     COMPLEX CSGN,CSPN,C1,C2,Y,Z,ZN,CY
-      DOUBLE PRECISION ALIM, ARG, ASCLE, AZ, CSGNR, CSGNI, CSPNR,
-     * CSPNI, C1R, C1I, C2R, C2I, CYR, CYI, DFNU, ELIM, FMR, FNU, PI,
-     * RL, SGN, TOL, YY, YR, YI, ZR, ZI, ZNR, ZNI, D1MACH, ZABS
-      INTEGER INU, IUF, KODE, MR, N, NN, NW, NZ
-      DIMENSION YR(N), YI(N), CYR(2), CYI(2)
-      DATA PI / 3.14159265358979324D0 /
-      NZ = 0
-      ZNR = -ZR
-      ZNI = -ZI
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      NN = N
-      DFNU = FNU + DBLE(FLOAT(N-1))
-      IF (AZ.LE.2.0D0) GO TO 10
-      IF (AZ*AZ*0.25D0.GT.DFNU+1.0D0) GO TO 20
-   10 CONTINUE
-C-----------------------------------------------------------------------
-C     POWER SERIES FOR THE I FUNCTION
-C-----------------------------------------------------------------------
-      CALL ZSERI(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL, ELIM, ALIM)
-      GO TO 40
-   20 CONTINUE
-      IF (AZ.LT.RL) GO TO 30
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR LARGE Z FOR THE I FUNCTION
-C-----------------------------------------------------------------------
-      CALL ZASYI(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, RL, TOL, ELIM,
-     * ALIM)
-      IF (NW.LT.0) GO TO 80
-      GO TO 40
-   30 CONTINUE
-C-----------------------------------------------------------------------
-C     MILLER ALGORITHM NORMALIZED BY THE SERIES FOR THE I FUNCTION
-C-----------------------------------------------------------------------
-      CALL ZMLRI(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, TOL)
-      IF(NW.LT.0) GO TO 80
-   40 CONTINUE
-C-----------------------------------------------------------------------
-C     ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION
-C-----------------------------------------------------------------------
-      CALL ZBKNU(ZNR, ZNI, FNU, KODE, 1, CYR, CYI, NW, TOL, ELIM, ALIM)
-      IF (NW.NE.0) GO TO 80
-      FMR = DBLE(FLOAT(MR))
-      SGN = -DSIGN(PI,FMR)
-      CSGNR = 0.0D0
-      CSGNI = SGN
-      IF (KODE.EQ.1) GO TO 50
-      YY = -ZNI
-      CSGNR = -CSGNI*DSIN(YY)
-      CSGNI = CSGNI*DCOS(YY)
-   50 CONTINUE
-C-----------------------------------------------------------------------
-C     CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE
-C     WHEN FNU IS LARGE
-C-----------------------------------------------------------------------
-      INU = INT(SNGL(FNU))
-      ARG = (FNU-DBLE(FLOAT(INU)))*SGN
-      CSPNR = DCOS(ARG)
-      CSPNI = DSIN(ARG)
-      IF (MOD(INU,2).EQ.0) GO TO 60
-      CSPNR = -CSPNR
-      CSPNI = -CSPNI
-   60 CONTINUE
-      C1R = CYR(1)
-      C1I = CYI(1)
-      C2R = YR(1)
-      C2I = YI(1)
-      IF (KODE.EQ.1) GO TO 70
-      IUF = 0
-      ASCLE = 1.0D+3*D1MACH(1)/TOL
-      CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF)
-      NZ = NZ + NW
-   70 CONTINUE
-      YR(1) = CSPNR*C1R - CSPNI*C1I + CSGNR*C2R - CSGNI*C2I
-      YI(1) = CSPNR*C1I + CSPNI*C1R + CSGNR*C2I + CSGNI*C2R
-      RETURN
-   80 CONTINUE
-      NZ = -1
-      IF(NW.EQ.(-2)) NZ=-2
-      RETURN
-      END

amos/zacon.f

@@ -1,203 +0,0 @@
-      SUBROUTINE ZACON(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, FNUL,
-     * TOL, ELIM, ALIM)
-C***BEGIN PROLOGUE  ZACON
-C***REFER TO  ZBESK,ZBESH
-C
-C     ZACON APPLIES THE ANALYTIC CONTINUATION FORMULA
-C
-C         K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN)
-C                 MP=PI*MR*CMPLX(0.0,1.0)
-C
-C     TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT
-C     HALF Z PLANE
-C
-C***ROUTINES CALLED  ZBINU,ZBKNU,ZS1S2,D1MACH,ZABS,ZMLT
-C***END PROLOGUE  ZACON
-C     COMPLEX CK,CONE,CSCL,CSCR,CSGN,CSPN,CY,CZERO,C1,C2,RZ,SC1,SC2,ST,
-C    *S1,S2,Y,Z,ZN
-      DOUBLE PRECISION ALIM, ARG, ASCLE, AS2, AZN, BRY, BSCLE, CKI,
-     * CKR, CONER, CPN, CSCL, CSCR, CSGNI, CSGNR, CSPNI, CSPNR,
-     * CSR, CSRR, CSSR, CYI, CYR, C1I, C1M, C1R, C2I, C2R, ELIM, FMR,
-     * FN, FNU, FNUL, PI, PTI, PTR, RAZN, RL, RZI, RZR, SC1I, SC1R,
-     * SC2I, SC2R, SGN, SPN, STI, STR, S1I, S1R, S2I, S2R, TOL, YI, YR,
-     * YY, ZEROR, ZI, ZNI, ZNR, ZR, D1MACH, ZABS
-      INTEGER I, INU, IUF, KFLAG, KODE, MR, N, NN, NW, NZ
-      DIMENSION YR(N), YI(N), CYR(2), CYI(2), CSSR(3), CSRR(3), BRY(3)
-      DATA PI / 3.14159265358979324D0 /
-      DATA ZEROR,CONER / 0.0D0,1.0D0 /
-      NZ = 0
-      ZNR = -ZR
-      ZNI = -ZI
-      NN = N
-      CALL ZBINU(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, RL, FNUL, TOL,
-     * ELIM, ALIM)
-      IF (NW.LT.0) GO TO 90
-C-----------------------------------------------------------------------
-C     ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION
-C-----------------------------------------------------------------------
-      NN = MIN0(2,N)
-      CALL ZBKNU(ZNR, ZNI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM)
-      IF (NW.NE.0) GO TO 90
-      S1R = CYR(1)
-      S1I = CYI(1)
-      FMR = DBLE(FLOAT(MR))
-      SGN = -DSIGN(PI,FMR)
-      CSGNR = ZEROR
-      CSGNI = SGN
-      IF (KODE.EQ.1) GO TO 10
-      YY = -ZNI
-      CPN = DCOS(YY)
-      SPN = DSIN(YY)
-      CALL ZMLT(CSGNR, CSGNI, CPN, SPN, CSGNR, CSGNI)
-   10 CONTINUE
-C-----------------------------------------------------------------------
-C     CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE
-C     WHEN FNU IS LARGE
-C-----------------------------------------------------------------------
-      INU = INT(SNGL(FNU))
-      ARG = (FNU-DBLE(FLOAT(INU)))*SGN
-      CPN = DCOS(ARG)
-      SPN = DSIN(ARG)
-      CSPNR = CPN
-      CSPNI = SPN
-      IF (MOD(INU,2).EQ.0) GO TO 20
-      CSPNR = -CSPNR
-      CSPNI = -CSPNI
-   20 CONTINUE
-      IUF = 0
-      C1R = S1R
-      C1I = S1I
-      C2R = YR(1)
-      C2I = YI(1)
-      ASCLE = 1.0D+3*D1MACH(1)/TOL
-      IF (KODE.EQ.1) GO TO 30
-      CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF)
-      NZ = NZ + NW
-      SC1R = C1R
-      SC1I = C1I
-   30 CONTINUE
-      CALL ZMLT(CSPNR, CSPNI, C1R, C1I, STR, STI)
-      CALL ZMLT(CSGNR, CSGNI, C2R, C2I, PTR, PTI)
-      YR(1) = STR + PTR
-      YI(1) = STI + PTI
-      IF (N.EQ.1) RETURN
-      CSPNR = -CSPNR
-      CSPNI = -CSPNI
-      S2R = CYR(2)
-      S2I = CYI(2)
-      C1R = S2R
-      C1I = S2I
-      C2R = YR(2)
-      C2I = YI(2)
-      IF (KODE.EQ.1) GO TO 40
-      CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF)
-      NZ = NZ + NW
-      SC2R = C1R
-      SC2I = C1I
-   40 CONTINUE
-      CALL ZMLT(CSPNR, CSPNI, C1R, C1I, STR, STI)
-      CALL ZMLT(CSGNR, CSGNI, C2R, C2I, PTR, PTI)
-      YR(2) = STR + PTR
-      YI(2) = STI + PTI
-      IF (N.EQ.2) RETURN
-      CSPNR = -CSPNR
-      CSPNI = -CSPNI
-      AZN = ZABS(COMPLEX(ZNR,ZNI))
-      RAZN = 1.0D0/AZN
-      STR = ZNR*RAZN
-      STI = -ZNI*RAZN
-      RZR = (STR+STR)*RAZN
-      RZI = (STI+STI)*RAZN
-      FN = FNU + 1.0D0
-      CKR = FN*RZR
-      CKI = FN*RZI
-C-----------------------------------------------------------------------
-C     SCALE NEAR EXPONENT EXTREMES DURING RECURRENCE ON K FUNCTIONS
-C-----------------------------------------------------------------------
-      CSCL = 1.0D0/TOL
-      CSCR = TOL
-      CSSR(1) = CSCL
-      CSSR(2) = CONER
-      CSSR(3) = CSCR
-      CSRR(1) = CSCR
-      CSRR(2) = CONER
-      CSRR(3) = CSCL
-      BRY(1) = ASCLE
-      BRY(2) = 1.0D0/ASCLE
-      BRY(3) = D1MACH(2)
-      AS2 = ZABS(COMPLEX(S2R,S2I))
-      KFLAG = 2
-      IF (AS2.GT.BRY(1)) GO TO 50
-      KFLAG = 1
-      GO TO 60
-   50 CONTINUE
-      IF (AS2.LT.BRY(2)) GO TO 60
-      KFLAG = 3
-   60 CONTINUE
-      BSCLE = BRY(KFLAG)
-      S1R = S1R*CSSR(KFLAG)
-      S1I = S1I*CSSR(KFLAG)
-      S2R = S2R*CSSR(KFLAG)
-      S2I = S2I*CSSR(KFLAG)
-      CSR = CSRR(KFLAG)
-      DO 80 I=3,N
-        STR = S2R
-        STI = S2I
-        S2R = CKR*STR - CKI*STI + S1R
-        S2I = CKR*STI + CKI*STR + S1I
-        S1R = STR
-        S1I = STI
-        C1R = S2R*CSR
-        C1I = S2I*CSR
-        STR = C1R
-        STI = C1I
-        C2R = YR(I)
-        C2I = YI(I)
-        IF (KODE.EQ.1) GO TO 70
-        IF (IUF.LT.0) GO TO 70
-        CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF)
-        NZ = NZ + NW
-        SC1R = SC2R
-        SC1I = SC2I
-        SC2R = C1R
-        SC2I = C1I
-        IF (IUF.NE.3) GO TO 70
-        IUF = -4
-        S1R = SC1R*CSSR(KFLAG)
-        S1I = SC1I*CSSR(KFLAG)
-        S2R = SC2R*CSSR(KFLAG)
-        S2I = SC2I*CSSR(KFLAG)
-        STR = SC2R
-        STI = SC2I
-   70   CONTINUE
-        PTR = CSPNR*C1R - CSPNI*C1I
-        PTI = CSPNR*C1I + CSPNI*C1R
-        YR(I) = PTR + CSGNR*C2R - CSGNI*C2I
-        YI(I) = PTI + CSGNR*C2I + CSGNI*C2R
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        CSPNR = -CSPNR
-        CSPNI = -CSPNI
-        IF (KFLAG.GE.3) GO TO 80
-        PTR = DABS(C1R)
-        PTI = DABS(C1I)
-        C1M = DMAX1(PTR,PTI)
-        IF (C1M.LE.BSCLE) GO TO 80
-        KFLAG = KFLAG + 1
-        BSCLE = BRY(KFLAG)
-        S1R = S1R*CSR
-        S1I = S1I*CSR
-        S2R = STR
-        S2I = STI
-        S1R = S1R*CSSR(KFLAG)
-        S1I = S1I*CSSR(KFLAG)
-        S2R = S2R*CSSR(KFLAG)
-        S2I = S2I*CSSR(KFLAG)
-        CSR = CSRR(KFLAG)
-   80 CONTINUE
-      RETURN
-   90 CONTINUE
-      NZ = -1
-      IF(NW.EQ.(-2)) NZ=-2
-      RETURN
-      END

amos/zairy.f

@@ -1,393 +0,0 @@
-      SUBROUTINE ZAIRY(ZR, ZI, ID, KODE, AIR, AII, NZ, IERR)
-C***BEGIN PROLOGUE  ZAIRY
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  890801   (YYMMDD)
-C***CATEGORY NO.  B5K
-C***KEYWORDS  AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE AIRY FUNCTIONS AI(Z) AND DAI(Z) FOR COMPLEX Z
-C***DESCRIPTION
-C
-C                      ***A DOUBLE PRECISION ROUTINE***
-C         ON KODE=1, ZAIRY COMPUTES THE COMPLEX AIRY FUNCTION AI(Z) OR
-C         ITS DERIVATIVE DAI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON
-C         KODE=2, A SCALING OPTION CEXP(ZTA)*AI(Z) OR CEXP(ZTA)*
-C         DAI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL DECAY IN
-C         -PI/3.LT.ARG(Z).LT.PI/3 AND THE EXPONENTIAL GROWTH IN
-C         PI/3.LT.ABS(ARG(Z)).LT.PI WHERE ZTA=(2/3)*Z*CSQRT(Z).
-C
-C         WHILE THE AIRY FUNCTIONS AI(Z) AND DAI(Z)/DZ ARE ANALYTIC IN
-C         THE WHOLE Z PLANE, THE CORRESPONDING SCALED FUNCTIONS DEFINED
-C         FOR KODE=2 HAVE A CUT ALONG THE NEGATIVE REAL AXIS.
-C         DEFINTIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF
-C         MATHEMATICAL FUNCTIONS (REF. 1).
-C
-C         INPUT      ZR,ZI ARE DOUBLE PRECISION
-C           ZR,ZI  - Z=CMPLX(ZR,ZI)
-C           ID     - ORDER OF DERIVATIVE, ID=0 OR ID=1
-C           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION
-C                    KODE= 1  RETURNS
-C                             AI=AI(Z)                ON ID=0 OR
-C                             AI=DAI(Z)/DZ            ON ID=1
-C                        = 2  RETURNS
-C                             AI=CEXP(ZTA)*AI(Z)       ON ID=0 OR
-C                             AI=CEXP(ZTA)*DAI(Z)/DZ   ON ID=1 WHERE
-C                             ZTA=(2/3)*Z*CSQRT(Z)
-C
-C         OUTPUT     AIR,AII ARE DOUBLE PRECISION
-C           AIR,AII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND
-C                    KODE
-C           NZ     - UNDERFLOW INDICATOR
-C                    NZ= 0   , NORMAL RETURN
-C                    NZ= 1   , AI=CMPLX(0.0D0,0.0D0) DUE TO UNDERFLOW IN
-C                              -PI/3.LT.ARG(Z).LT.PI/3 ON KODE=1
-C           IERR   - ERROR FLAG
-C                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED
-C                    IERR=1, INPUT ERROR   - NO COMPUTATION
-C                    IERR=2, OVERFLOW      - NO COMPUTATION, REAL(ZTA)
-C                            TOO LARGE ON KODE=1
-C                    IERR=3, CABS(Z) LARGE      - COMPUTATION COMPLETED
-C                            LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION
-C                            PRODUCE LESS THAN HALF OF MACHINE ACCURACY
-C                    IERR=4, CABS(Z) TOO LARGE  - NO COMPUTATION
-C                            COMPLETE LOSS OF ACCURACY BY ARGUMENT
-C                            REDUCTION
-C                    IERR=5, ERROR              - NO COMPUTATION,
-C                            ALGORITHM TERMINATION CONDITION NOT MET
-C
-C***LONG DESCRIPTION
-C
-C         AI AND DAI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE K BESSEL
-C         FUNCTIONS BY
-C
-C            AI(Z)=C*SQRT(Z)*K(1/3,ZTA) , DAI(Z)=-C*Z*K(2/3,ZTA)
-C                           C=1.0/(PI*SQRT(3.0))
-C                            ZTA=(2/3)*Z**(3/2)
-C
-C         WITH THE POWER SERIES FOR CABS(Z).LE.1.0.
-C
-C         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE-
-C         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES
-C         OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF
-C         THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR),
-C         THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR
-C         FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS
-C         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION.
-C         ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN
-C         ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT
-C         FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE
-C         LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA
-C         MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2,
-C         AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE
-C         PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE
-C         PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT-
-C         ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG-
-C         NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN
-C         DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN
-C         EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES,
-C         NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE
-C         PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER
-C         MACHINES.
-C
-C         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX
-C         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT
-C         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE-
-C         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE
-C         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))),
-C         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF
-C         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY
-C         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN
-C         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY
-C         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER
-C         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K,
-C         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS
-C         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER
-C         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY
-C         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER
-C         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE
-C         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES,
-C         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P,
-C         OR -PI/2+P.
-C
-C***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ
-C                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF
-C                 COMMERCE, 1955.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983
-C
-C               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85-
-C                 1018, MAY, 1985
-C
-C               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS.
-C                 MATH. SOFTWARE, 1986
-C
-C***ROUTINES CALLED  ZACAI,ZBKNU,ZEXP,ZSQRT,I1MACH,D1MACH
-C***END PROLOGUE  ZAIRY
-C     COMPLEX AI,CONE,CSQ,CY,S1,S2,TRM1,TRM2,Z,ZTA,Z3
-      DOUBLE PRECISION AA, AD, AII, AIR, AK, ALIM, ATRM, AZ, AZ3, BK,
-     * CC, CK, COEF, CONEI, CONER, CSQI, CSQR, CYI, CYR, C1, C2, DIG,
-     * DK, D1, D2, ELIM, FID, FNU, PTR, RL, R1M5, SFAC, STI, STR,
-     * S1I, S1R, S2I, S2R, TOL, TRM1I, TRM1R, TRM2I, TRM2R, TTH, ZEROI,
-     * ZEROR, ZI, ZR, ZTAI, ZTAR, Z3I, Z3R, D1MACH, ZABS, ALAZ, BB
-      INTEGER ID, IERR, IFLAG, K, KODE, K1, K2, MR, NN, NZ, I1MACH
-      DIMENSION CYR(1), CYI(1)
-      DATA TTH, C1, C2, COEF /6.66666666666666667D-01,
-     * 3.55028053887817240D-01,2.58819403792806799D-01,
-     * 1.83776298473930683D-01/
-      DATA ZEROR, ZEROI, CONER, CONEI /0.0D0,0.0D0,1.0D0,0.0D0/
-C***FIRST EXECUTABLE STATEMENT  ZAIRY
-      IERR = 0
-      NZ=0
-      IF (ID.LT.0 .OR. ID.GT.1) IERR=1
-      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
-      IF (IERR.NE.0) RETURN
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      TOL = DMAX1(D1MACH(4),1.0D-18)
-      FID = DBLE(FLOAT(ID))
-      IF (AZ.GT.1.0D0) GO TO 70
-C-----------------------------------------------------------------------
-C     POWER SERIES FOR CABS(Z).LE.1.
-C-----------------------------------------------------------------------
-      S1R = CONER
-      S1I = CONEI
-      S2R = CONER
-      S2I = CONEI
-      IF (AZ.LT.TOL) GO TO 170
-      AA = AZ*AZ
-      IF (AA.LT.TOL/AZ) GO TO 40
-      TRM1R = CONER
-      TRM1I = CONEI
-      TRM2R = CONER
-      TRM2I = CONEI
-      ATRM = 1.0D0
-      STR = ZR*ZR - ZI*ZI
-      STI = ZR*ZI + ZI*ZR
-      Z3R = STR*ZR - STI*ZI
-      Z3I = STR*ZI + STI*ZR
-      AZ3 = AZ*AA
-      AK = 2.0D0 + FID
-      BK = 3.0D0 - FID - FID
-      CK = 4.0D0 - FID
-      DK = 3.0D0 + FID + FID
-      D1 = AK*DK
-      D2 = BK*CK
-      AD = DMIN1(D1,D2)
-      AK = 24.0D0 + 9.0D0*FID
-      BK = 30.0D0 - 9.0D0*FID
-      DO 30 K=1,25
-        STR = (TRM1R*Z3R-TRM1I*Z3I)/D1
-        TRM1I = (TRM1R*Z3I+TRM1I*Z3R)/D1
-        TRM1R = STR
-        S1R = S1R + TRM1R
-        S1I = S1I + TRM1I
-        STR = (TRM2R*Z3R-TRM2I*Z3I)/D2
-        TRM2I = (TRM2R*Z3I+TRM2I*Z3R)/D2
-        TRM2R = STR
-        S2R = S2R + TRM2R
-        S2I = S2I + TRM2I
-        ATRM = ATRM*AZ3/AD
-        D1 = D1 + AK
-        D2 = D2 + BK
-        AD = DMIN1(D1,D2)
-        IF (ATRM.LT.TOL*AD) GO TO 40
-        AK = AK + 18.0D0
-        BK = BK + 18.0D0
-   30 CONTINUE
-   40 CONTINUE
-      IF (ID.EQ.1) GO TO 50
-      AIR = S1R*C1 - C2*(ZR*S2R-ZI*S2I)
-      AII = S1I*C1 - C2*(ZR*S2I+ZI*S2R)
-      IF (KODE.EQ.1) RETURN
-      CALL ZSQRT(ZR, ZI, STR, STI)
-      ZTAR = TTH*(ZR*STR-ZI*STI)
-      ZTAI = TTH*(ZR*STI+ZI*STR)
-      CALL ZEXP(ZTAR, ZTAI, STR, STI)
-      PTR = AIR*STR - AII*STI
-      AII = AIR*STI + AII*STR
-      AIR = PTR
-      RETURN
-   50 CONTINUE
-      AIR = -S2R*C2
-      AII = -S2I*C2
-      IF (AZ.LE.TOL) GO TO 60
-      STR = ZR*S1R - ZI*S1I
-      STI = ZR*S1I + ZI*S1R
-      CC = C1/(1.0D0+FID)
-      AIR = AIR + CC*(STR*ZR-STI*ZI)
-      AII = AII + CC*(STR*ZI+STI*ZR)
-   60 CONTINUE
-      IF (KODE.EQ.1) RETURN
-      CALL ZSQRT(ZR, ZI, STR, STI)
-      ZTAR = TTH*(ZR*STR-ZI*STI)
-      ZTAI = TTH*(ZR*STI+ZI*STR)
-      CALL ZEXP(ZTAR, ZTAI, STR, STI)
-      PTR = STR*AIR - STI*AII
-      AII = STR*AII + STI*AIR
-      AIR = PTR
-      RETURN
-C-----------------------------------------------------------------------
-C     CASE FOR CABS(Z).GT.1.0
-C-----------------------------------------------------------------------
-   70 CONTINUE
-      FNU = (1.0D0+FID)/3.0D0
-C-----------------------------------------------------------------------
-C     SET PARAMETERS RELATED TO MACHINE CONSTANTS.
-C     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0D-18.
-C     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
-C     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND
-C     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR
-C     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
-C     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
-C     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
-C-----------------------------------------------------------------------
-      K1 = I1MACH(15)
-      K2 = I1MACH(16)
-      R1M5 = D1MACH(5)
-      K = MIN0(IABS(K1),IABS(K2))
-      ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0)
-      K1 = I1MACH(14) - 1
-      AA = R1M5*DBLE(FLOAT(K1))
-      DIG = DMIN1(AA,18.0D0)
-      AA = AA*2.303D0
-      ALIM = ELIM + DMAX1(-AA,-41.45D0)
-      RL = 1.2D0*DIG + 3.0D0
-      ALAZ = DLOG(AZ)
-C--------------------------------------------------------------------------
-C     TEST FOR PROPER RANGE
-C-----------------------------------------------------------------------
-      AA=0.5D0/TOL
-      BB=DBLE(FLOAT(I1MACH(9)))*0.5D0
-      AA=DMIN1(AA,BB)
-      AA=AA**TTH
-      IF (AZ.GT.AA) GO TO 260
-      AA=DSQRT(AA)
-      IF (AZ.GT.AA) IERR=3
-      CALL ZSQRT(ZR, ZI, CSQR, CSQI)
-      ZTAR = TTH*(ZR*CSQR-ZI*CSQI)
-      ZTAI = TTH*(ZR*CSQI+ZI*CSQR)
-C-----------------------------------------------------------------------
-C     RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL
-C-----------------------------------------------------------------------
-      IFLAG = 0
-      SFAC = 1.0D0
-      AK = ZTAI
-      IF (ZR.GE.0.0D0) GO TO 80
-      BK = ZTAR
-      CK = -DABS(BK)
-      ZTAR = CK
-      ZTAI = AK
-   80 CONTINUE
-      IF (ZI.NE.0.0D0) GO TO 90
-      IF (ZR.GT.0.0D0) GO TO 90
-      ZTAR = 0.0D0
-      ZTAI = AK
-   90 CONTINUE
-      AA = ZTAR
-      IF (AA.GE.0.0D0 .AND. ZR.GT.0.0D0) GO TO 110
-      IF (KODE.EQ.2) GO TO 100
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST
-C-----------------------------------------------------------------------
-      IF (AA.GT.(-ALIM)) GO TO 100
-      AA = -AA + 0.25D0*ALAZ
-      IFLAG = 1
-      SFAC = TOL
-      IF (AA.GT.ELIM) GO TO 270
-  100 CONTINUE
-C-----------------------------------------------------------------------
-C     CBKNU AND CACON RETURN EXP(ZTA)*K(FNU,ZTA) ON KODE=2
-C-----------------------------------------------------------------------
-      MR = 1
-      IF (ZI.LT.0.0D0) MR = -1
-      CALL ZACAI(ZTAR, ZTAI, FNU, KODE, MR, 1, CYR, CYI, NN, RL, TOL,
-     * ELIM, ALIM)
-      IF (NN.LT.0) GO TO 280
-      NZ = NZ + NN
-      GO TO 130
-  110 CONTINUE
-      IF (KODE.EQ.2) GO TO 120
-C-----------------------------------------------------------------------
-C     UNDERFLOW TEST
-C-----------------------------------------------------------------------
-      IF (AA.LT.ALIM) GO TO 120
-      AA = -AA - 0.25D0*ALAZ
-      IFLAG = 2
-      SFAC = 1.0D0/TOL
-      IF (AA.LT.(-ELIM)) GO TO 210
-  120 CONTINUE
-      CALL ZBKNU(ZTAR, ZTAI, FNU, KODE, 1, CYR, CYI, NZ, TOL, ELIM,
-     * ALIM)
-  130 CONTINUE
-      S1R = CYR(1)*COEF
-      S1I = CYI(1)*COEF
-      IF (IFLAG.NE.0) GO TO 150
-      IF (ID.EQ.1) GO TO 140
-      AIR = CSQR*S1R - CSQI*S1I
-      AII = CSQR*S1I + CSQI*S1R
-      RETURN
-  140 CONTINUE
-      AIR = -(ZR*S1R-ZI*S1I)
-      AII = -(ZR*S1I+ZI*S1R)
-      RETURN
-  150 CONTINUE
-      S1R = S1R*SFAC
-      S1I = S1I*SFAC
-      IF (ID.EQ.1) GO TO 160
-      STR = S1R*CSQR - S1I*CSQI
-      S1I = S1R*CSQI + S1I*CSQR
-      S1R = STR
-      AIR = S1R/SFAC
-      AII = S1I/SFAC
-      RETURN
-  160 CONTINUE
-      STR = -(S1R*ZR-S1I*ZI)
-      S1I = -(S1R*ZI+S1I*ZR)
-      S1R = STR
-      AIR = S1R/SFAC
-      AII = S1I/SFAC
-      RETURN
-  170 CONTINUE
-      AA = 1.0D+3*D1MACH(1)
-      S1R = ZEROR
-      S1I = ZEROI
-      IF (ID.EQ.1) GO TO 190
-      IF (AZ.LE.AA) GO TO 180
-      S1R = C2*ZR
-      S1I = C2*ZI
-  180 CONTINUE
-      AIR = C1 - S1R
-      AII = -S1I
-      RETURN
-  190 CONTINUE
-      AIR = -C2
-      AII = 0.0D0
-      AA = DSQRT(AA)
-      IF (AZ.LE.AA) GO TO 200
-      S1R = 0.5D0*(ZR*ZR-ZI*ZI)
-      S1I = ZR*ZI
-  200 CONTINUE
-      AIR = AIR + C1*S1R
-      AII = AII + C1*S1I
-      RETURN
-  210 CONTINUE
-      NZ = 1
-      AIR = ZEROR
-      AII = ZEROI
-      RETURN
-  270 CONTINUE
-      NZ = 0
-      IERR=2
-      RETURN
-  280 CONTINUE
-      IF(NN.EQ.(-1)) GO TO 270
-      NZ=0
-      IERR=5
-      RETURN
-  260 CONTINUE
-      IERR=4
-      NZ=0
-      RETURN
-      END

amos/zasyi.f

@@ -1,165 +0,0 @@
-      SUBROUTINE ZASYI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM,
-     * ALIM)
-C***BEGIN PROLOGUE  ZASYI
-C***REFER TO  ZBESI,ZBESK
-C
-C     ZASYI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY
-C     MEANS OF THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z) IN THE
-C     REGION CABS(Z).GT.MAX(RL,FNU*FNU/2). NZ=0 IS A NORMAL RETURN.
-C     NZ.LT.0 INDICATES AN OVERFLOW ON KODE=1.
-C
-C***ROUTINES CALLED  D1MACH,ZABS,ZDIV,ZEXP,ZMLT,ZSQRT
-C***END PROLOGUE  ZASYI
-C     COMPLEX AK1,CK,CONE,CS1,CS2,CZ,CZERO,DK,EZ,P1,RZ,S2,Y,Z
-      DOUBLE PRECISION AA, AEZ, AK, AK1I, AK1R, ALIM, ARG, ARM, ATOL,
-     * AZ, BB, BK, CKI, CKR, CONEI, CONER, CS1I, CS1R, CS2I, CS2R, CZI,
-     * CZR, DFNU, DKI, DKR, DNU2, ELIM, EZI, EZR, FDN, FNU, PI, P1I,
-     * P1R, RAZ, RL, RTPI, RTR1, RZI, RZR, S, SGN, SQK, STI, STR, S2I,
-     * S2R, TOL, TZI, TZR, YI, YR, ZEROI, ZEROR, ZI, ZR, D1MACH, ZABS
-      INTEGER I, IB, IL, INU, J, JL, K, KODE, KODED, M, N, NN, NZ
-      DIMENSION YR(N), YI(N)
-      DATA PI, RTPI  /3.14159265358979324D0 , 0.159154943091895336D0 /
-      DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 /
-C
-      NZ = 0
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      ARM = 1.0D+3*D1MACH(1)
-      RTR1 = DSQRT(ARM)
-      IL = MIN0(2,N)
-      DFNU = FNU + DBLE(FLOAT(N-IL))
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST
-C-----------------------------------------------------------------------
-      RAZ = 1.0D0/AZ
-      STR = ZR*RAZ
-      STI = -ZI*RAZ
-      AK1R = RTPI*STR*RAZ
-      AK1I = RTPI*STI*RAZ
-      CALL ZSQRT(AK1R, AK1I, AK1R, AK1I)
-      CZR = ZR
-      CZI = ZI
-      IF (KODE.NE.2) GO TO 10
-      CZR = ZEROR
-      CZI = ZI
-   10 CONTINUE
-      IF (DABS(CZR).GT.ELIM) GO TO 100
-      DNU2 = DFNU + DFNU
-      KODED = 1
-      IF ((DABS(CZR).GT.ALIM) .AND. (N.GT.2)) GO TO 20
-      KODED = 0
-      CALL ZEXP(CZR, CZI, STR, STI)
-      CALL ZMLT(AK1R, AK1I, STR, STI, AK1R, AK1I)
-   20 CONTINUE
-      FDN = 0.0D0
-      IF (DNU2.GT.RTR1) FDN = DNU2*DNU2
-      EZR = ZR*8.0D0
-      EZI = ZI*8.0D0
-C-----------------------------------------------------------------------
-C     WHEN Z IS IMAGINARY, THE ERROR TEST MUST BE MADE RELATIVE TO THE
-C     FIRST RECIPROCAL POWER SINCE THIS IS THE LEADING TERM OF THE
-C     EXPANSION FOR THE IMAGINARY PART.
-C-----------------------------------------------------------------------
-      AEZ = 8.0D0*AZ
-      S = TOL/AEZ
-      JL = INT(SNGL(RL+RL)) + 2
-      P1R = ZEROR
-      P1I = ZEROI
-      IF (ZI.EQ.0.0D0) GO TO 30
-C-----------------------------------------------------------------------
-C     CALCULATE EXP(PI*(0.5+FNU+N-IL)*I) TO MINIMIZE LOSSES OF
-C     SIGNIFICANCE WHEN FNU OR N IS LARGE
-C-----------------------------------------------------------------------
-      INU = INT(SNGL(FNU))
-      ARG = (FNU-DBLE(FLOAT(INU)))*PI
-      INU = INU + N - IL
-      AK = -DSIN(ARG)
-      BK = DCOS(ARG)
-      IF (ZI.LT.0.0D0) BK = -BK
-      P1R = AK
-      P1I = BK
-      IF (MOD(INU,2).EQ.0) GO TO 30
-      P1R = -P1R
-      P1I = -P1I
-   30 CONTINUE
-      DO 70 K=1,IL
-        SQK = FDN - 1.0D0
-        ATOL = S*DABS(SQK)
-        SGN = 1.0D0
-        CS1R = CONER
-        CS1I = CONEI
-        CS2R = CONER
-        CS2I = CONEI
-        CKR = CONER
-        CKI = CONEI
-        AK = 0.0D0
-        AA = 1.0D0
-        BB = AEZ
-        DKR = EZR
-        DKI = EZI
-        DO 40 J=1,JL
-          CALL ZDIV(CKR, CKI, DKR, DKI, STR, STI)
-          CKR = STR*SQK
-          CKI = STI*SQK
-          CS2R = CS2R + CKR
-          CS2I = CS2I + CKI
-          SGN = -SGN
-          CS1R = CS1R + CKR*SGN
-          CS1I = CS1I + CKI*SGN
-          DKR = DKR + EZR
-          DKI = DKI + EZI
-          AA = AA*DABS(SQK)/BB
-          BB = BB + AEZ
-          AK = AK + 8.0D0
-          SQK = SQK - AK
-          IF (AA.LE.ATOL) GO TO 50
-   40   CONTINUE
-        GO TO 110
-   50   CONTINUE
-        S2R = CS1R
-        S2I = CS1I
-        IF (ZR+ZR.GE.ELIM) GO TO 60
-        TZR = ZR + ZR
-        TZI = ZI + ZI
-        CALL ZEXP(-TZR, -TZI, STR, STI)
-        CALL ZMLT(STR, STI, P1R, P1I, STR, STI)
-        CALL ZMLT(STR, STI, CS2R, CS2I, STR, STI)
-        S2R = S2R + STR
-        S2I = S2I + STI
-   60   CONTINUE
-        FDN = FDN + 8.0D0*DFNU + 4.0D0
-        P1R = -P1R
-        P1I = -P1I
-        M = N - IL + K
-        YR(M) = S2R*AK1R - S2I*AK1I
-        YI(M) = S2R*AK1I + S2I*AK1R
-   70 CONTINUE
-      IF (N.LE.2) RETURN
-      NN = N
-      K = NN - 2
-      AK = DBLE(FLOAT(K))
-      STR = ZR*RAZ
-      STI = -ZI*RAZ
-      RZR = (STR+STR)*RAZ
-      RZI = (STI+STI)*RAZ
-      IB = 3
-      DO 80 I=IB,NN
-        YR(K) = (AK+FNU)*(RZR*YR(K+1)-RZI*YI(K+1)) + YR(K+2)
-        YI(K) = (AK+FNU)*(RZR*YI(K+1)+RZI*YR(K+1)) + YI(K+2)
-        AK = AK - 1.0D0
-        K = K - 1
-   80 CONTINUE
-      IF (KODED.EQ.0) RETURN
-      CALL ZEXP(CZR, CZI, CKR, CKI)
-      DO 90 I=1,NN
-        STR = YR(I)*CKR - YI(I)*CKI
-        YI(I) = YR(I)*CKI + YI(I)*CKR
-        YR(I) = STR
-   90 CONTINUE
-      RETURN
-  100 CONTINUE
-      NZ = -1
-      RETURN
-  110 CONTINUE
-      NZ=-2
-      RETURN
-      END

amos/zbesh.f

@@ -1,348 +0,0 @@
-      SUBROUTINE ZBESH(ZR, ZI, FNU, KODE, M, N, CYR, CYI, NZ, IERR)
-C***BEGIN PROLOGUE  ZBESH
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  890801   (YYMMDD)
-C***CATEGORY NO.  B5K
-C***KEYWORDS  H-BESSEL FUNCTIONS,BESSEL FUNCTIONS OF COMPLEX ARGUMENT,
-C             BESSEL FUNCTIONS OF THIRD KIND,HANKEL FUNCTIONS
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE THE H-BESSEL FUNCTIONS OF A COMPLEX ARGUMENT
-C***DESCRIPTION
-C
-C                      ***A DOUBLE PRECISION ROUTINE***
-C         ON KODE=1, ZBESH COMPUTES AN N MEMBER SEQUENCE OF COMPLEX
-C         HANKEL (BESSEL) FUNCTIONS CY(J)=H(M,FNU+J-1,Z) FOR KINDS M=1
-C         OR 2, REAL, NONNEGATIVE ORDERS FNU+J-1, J=1,...,N, AND COMPLEX
-C         Z.NE.CMPLX(0.0,0.0) IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI.
-C         ON KODE=2, ZBESH RETURNS THE SCALED HANKEL FUNCTIONS
-C
-C         CY(I)=EXP(-MM*Z*I)*H(M,FNU+J-1,Z)       MM=3-2*M,   I**2=-1.
-C
-C         WHICH REMOVES THE EXPONENTIAL BEHAVIOR IN BOTH THE UPPER AND
-C         LOWER HALF PLANES. DEFINITIONS AND NOTATION ARE FOUND IN THE
-C         NBS HANDBOOK OF MATHEMATICAL FUNCTIONS (REF. 1).
-C
-C         INPUT      ZR,ZI,FNU ARE DOUBLE PRECISION
-C           ZR,ZI  - Z=CMPLX(ZR,ZI), Z.NE.CMPLX(0.0D0,0.0D0),
-C                    -PT.LT.ARG(Z).LE.PI
-C           FNU    - ORDER OF INITIAL H FUNCTION, FNU.GE.0.0D0
-C           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION
-C                    KODE= 1  RETURNS
-C                             CY(J)=H(M,FNU+J-1,Z),   J=1,...,N
-C                        = 2  RETURNS
-C                             CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M))
-C                                  J=1,...,N  ,  I**2=-1
-C           M      - KIND OF HANKEL FUNCTION, M=1 OR 2
-C           N      - NUMBER OF MEMBERS IN THE SEQUENCE, N.GE.1
-C
-C         OUTPUT     CYR,CYI ARE DOUBLE PRECISION
-C           CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS
-C                    CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE
-C                    CY(J)=H(M,FNU+J-1,Z)  OR
-C                    CY(J)=H(M,FNU+J-1,Z)*EXP(-I*Z*(3-2M))  J=1,...,N
-C                    DEPENDING ON KODE, I**2=-1.
-C           NZ     - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW,
-C                    NZ= 0   , NORMAL RETURN
-C                    NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE
-C                              TO UNDERFLOW, CY(J)=CMPLX(0.0D0,0.0D0)
-C                              J=1,...,NZ WHEN Y.GT.0.0 AND M=1 OR
-C                              Y.LT.0.0 AND M=2. FOR THE COMPLMENTARY
-C                              HALF PLANES, NZ STATES ONLY THE NUMBER
-C                              OF UNDERFLOWS.
-C           IERR   - ERROR FLAG
-C                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED
-C                    IERR=1, INPUT ERROR   - NO COMPUTATION
-C                    IERR=2, OVERFLOW      - NO COMPUTATION, FNU TOO
-C                            LARGE OR CABS(Z) TOO SMALL OR BOTH
-C                    IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE
-C                            BUT LOSSES OF SIGNIFCANCE BY ARGUMENT
-C                            REDUCTION PRODUCE LESS THAN HALF OF MACHINE
-C                            ACCURACY
-C                    IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA-
-C                            TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI-
-C                            CANCE BY ARGUMENT REDUCTION
-C                    IERR=5, ERROR              - NO COMPUTATION,
-C                            ALGORITHM TERMINATION CONDITION NOT MET
-C
-C***LONG DESCRIPTION
-C
-C         THE COMPUTATION IS CARRIED OUT BY THE RELATION
-C
-C         H(M,FNU,Z)=(1/MP)*EXP(-MP*FNU)*K(FNU,Z*EXP(-MP))
-C             MP=MM*HPI*I,  MM=3-2*M,  HPI=PI/2,  I**2=-1
-C
-C         FOR M=1 OR 2 WHERE THE K BESSEL FUNCTION IS COMPUTED FOR THE
-C         RIGHT HALF PLANE RE(Z).GE.0.0. THE K FUNCTION IS CONTINUED
-C         TO THE LEFT HALF PLANE BY THE RELATION
-C
-C         K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z)
-C         MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1
-C
-C         WHERE I(FNU,Z) IS THE I BESSEL FUNCTION.
-C
-C         EXPONENTIAL DECAY OF H(M,FNU,Z) OCCURS IN THE UPPER HALF Z
-C         PLANE FOR M=1 AND THE LOWER HALF Z PLANE FOR M=2.  EXPONENTIAL
-C         GROWTH OCCURS IN THE COMPLEMENTARY HALF PLANES.  SCALING
-C         BY EXP(-MM*Z*I) REMOVES THE EXPONENTIAL BEHAVIOR IN THE
-C         WHOLE Z PLANE FOR Z TO INFINITY.
-C
-C         FOR NEGATIVE ORDERS,THE FORMULAE
-C
-C               H(1,-FNU,Z) = H(1,FNU,Z)*CEXP( PI*FNU*I)
-C               H(2,-FNU,Z) = H(2,FNU,Z)*CEXP(-PI*FNU*I)
-C                         I**2=-1
-C
-C         CAN BE USED.
-C
-C         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE-
-C         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS
-C         LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR.
-C         CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN
-C         LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG
-C         IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS
-C         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION.
-C         IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS
-C         LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS
-C         MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE
-C         INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS
-C         RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3
-C         ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION
-C         ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION
-C         ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN
-C         THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT
-C         TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS
-C         IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC.
-C         SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES.
-C
-C         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX
-C         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT
-C         ROUNDOFF,1.0D-18) IS THE NOMINAL PRECISION AND 10**S REPRE-
-C         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE
-C         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))),
-C         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF
-C         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY
-C         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN
-C         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY
-C         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER
-C         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K,
-C         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS
-C         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER
-C         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY
-C         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER
-C         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE
-C         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES,
-C         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P,
-C         OR -PI/2+P.
-C
-C***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ
-C                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF
-C                 COMMERCE, 1955.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 BY D. E. AMOS, SAND83-0083, MAY, 1983.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983
-C
-C               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85-
-C                 1018, MAY, 1985
-C
-C               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS.
-C                 MATH. SOFTWARE, 1986
-C
-C***ROUTINES CALLED  ZACON,ZBKNU,ZBUNK,ZUOIK,ZABS,I1MACH,D1MACH
-C***END PROLOGUE  ZBESH
-C
-C     COMPLEX CY,Z,ZN,ZT,CSGN
-      DOUBLE PRECISION AA, ALIM, ALN, ARG, AZ, CYI, CYR, DIG, ELIM,
-     * FMM, FN, FNU, FNUL, HPI, RHPI, RL, R1M5, SGN, STR, TOL, UFL, ZI,
-     * ZNI, ZNR, ZR, ZTI, D1MACH, ZABS, BB, ASCLE, RTOL, ATOL, STI,
-     * CSGNR, CSGNI
-      INTEGER I, IERR, INU, INUH, IR, K, KODE, K1, K2, M,
-     * MM, MR, N, NN, NUF, NW, NZ, I1MACH
-      DIMENSION CYR(N), CYI(N)
-C
-      DATA HPI /1.57079632679489662D0/
-C
-C***FIRST EXECUTABLE STATEMENT  ZBESH
-      IERR = 0
-      NZ=0
-      IF (ZR.EQ.0.0D0 .AND. ZI.EQ.0.0D0) IERR=1
-      IF (FNU.LT.0.0D0) IERR=1
-      IF (M.LT.1 .OR. M.GT.2) IERR=1
-      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
-      IF (N.LT.1) IERR=1
-      IF (IERR.NE.0) RETURN
-      NN = N
-C-----------------------------------------------------------------------
-C     SET PARAMETERS RELATED TO MACHINE CONSTANTS.
-C     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18.
-C     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
-C     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND
-C     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR
-C     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
-C     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
-C     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
-C     FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU
-C-----------------------------------------------------------------------
-      TOL = DMAX1(D1MACH(4),1.0D-18)
-      K1 = I1MACH(15)
-      K2 = I1MACH(16)
-      R1M5 = D1MACH(5)
-      K = MIN0(IABS(K1),IABS(K2))
-      ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0)
-      K1 = I1MACH(14) - 1
-      AA = R1M5*DBLE(FLOAT(K1))
-      DIG = DMIN1(AA,18.0D0)
-      AA = AA*2.303D0
-      ALIM = ELIM + DMAX1(-AA,-41.45D0)
-      FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0)
-      RL = 1.2D0*DIG + 3.0D0
-      FN = FNU + DBLE(FLOAT(NN-1))
-      MM = 3 - M - M
-      FMM = DBLE(FLOAT(MM))
-      ZNR = FMM*ZI
-      ZNI = -FMM*ZR
-C-----------------------------------------------------------------------
-C     TEST FOR PROPER RANGE
-C-----------------------------------------------------------------------
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      AA = 0.5D0/TOL
-      BB=DBLE(FLOAT(I1MACH(9)))*0.5D0
-      AA = DMIN1(AA,BB)
-      IF (AZ.GT.AA) GO TO 260
-      IF (FN.GT.AA) GO TO 260
-      AA = DSQRT(AA)
-      IF (AZ.GT.AA) IERR=3
-      IF (FN.GT.AA) IERR=3
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE
-C-----------------------------------------------------------------------
-      UFL = D1MACH(1)*1.0D+3
-      IF (AZ.LT.UFL) GO TO 230
-      IF (FNU.GT.FNUL) GO TO 90
-      IF (FN.LE.1.0D0) GO TO 70
-      IF (FN.GT.2.0D0) GO TO 60
-      IF (AZ.GT.TOL) GO TO 70
-      ARG = 0.5D0*AZ
-      ALN = -FN*DLOG(ARG)
-      IF (ALN.GT.ELIM) GO TO 230
-      GO TO 70
-   60 CONTINUE
-      CALL ZUOIK(ZNR, ZNI, FNU, KODE, 2, NN, CYR, CYI, NUF, TOL, ELIM,
-     * ALIM)
-      IF (NUF.LT.0) GO TO 230
-      NZ = NZ + NUF
-      NN = NN - NUF
-C-----------------------------------------------------------------------
-C     HERE NN=N OR NN=0 SINCE NUF=0,NN, OR -1 ON RETURN FROM CUOIK
-C     IF NUF=NN, THEN CY(I)=CZERO FOR ALL I
-C-----------------------------------------------------------------------
-      IF (NN.EQ.0) GO TO 140
-   70 CONTINUE
-      IF ((ZNR.LT.0.0D0) .OR. (ZNR.EQ.0.0D0 .AND. ZNI.LT.0.0D0 .AND.
-     * M.EQ.2)) GO TO 80
-C-----------------------------------------------------------------------
-C     RIGHT HALF PLANE COMPUTATION, XN.GE.0. .AND. (XN.NE.0. .OR.
-C     YN.GE.0. .OR. M=1)
-C-----------------------------------------------------------------------
-      CALL ZBKNU(ZNR, ZNI, FNU, KODE, NN, CYR, CYI, NZ, TOL, ELIM, ALIM)
-      GO TO 110
-C-----------------------------------------------------------------------
-C     LEFT HALF PLANE COMPUTATION
-C-----------------------------------------------------------------------
-   80 CONTINUE
-      MR = -MM
-      CALL ZACON(ZNR, ZNI, FNU, KODE, MR, NN, CYR, CYI, NW, RL, FNUL,
-     * TOL, ELIM, ALIM)
-      IF (NW.LT.0) GO TO 240
-      NZ=NW
-      GO TO 110
-   90 CONTINUE
-C-----------------------------------------------------------------------
-C     UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU.GT.FNUL
-C-----------------------------------------------------------------------
-      MR = 0
-      IF ((ZNR.GE.0.0D0) .AND. (ZNR.NE.0.0D0 .OR. ZNI.GE.0.0D0 .OR.
-     * M.NE.2)) GO TO 100
-      MR = -MM
-      IF (ZNR.NE.0.0D0 .OR. ZNI.GE.0.0D0) GO TO 100
-      ZNR = -ZNR
-      ZNI = -ZNI
-  100 CONTINUE
-      CALL ZBUNK(ZNR, ZNI, FNU, KODE, MR, NN, CYR, CYI, NW, TOL, ELIM,
-     * ALIM)
-      IF (NW.LT.0) GO TO 240
-      NZ = NZ + NW
-  110 CONTINUE
-C-----------------------------------------------------------------------
-C     H(M,FNU,Z) = -FMM*(I/HPI)*(ZT**FNU)*K(FNU,-Z*ZT)
-C
-C     ZT=EXP(-FMM*HPI*I) = CMPLX(0.0,-FMM), FMM=3-2*M, M=1,2
-C-----------------------------------------------------------------------
-      SGN = DSIGN(HPI,-FMM)
-C-----------------------------------------------------------------------
-C     CALCULATE EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE
-C     WHEN FNU IS LARGE
-C-----------------------------------------------------------------------
-      INU = INT(SNGL(FNU))
-      INUH = INU/2
-      IR = INU - 2*INUH
-      ARG = (FNU-DBLE(FLOAT(INU-IR)))*SGN
-      RHPI = 1.0D0/SGN
-C     ZNI = RHPI*DCOS(ARG)
-C     ZNR = -RHPI*DSIN(ARG)
-      CSGNI = RHPI*DCOS(ARG)
-      CSGNR = -RHPI*DSIN(ARG)
-      IF (MOD(INUH,2).EQ.0) GO TO 120
-C     ZNR = -ZNR
-C     ZNI = -ZNI
-      CSGNR = -CSGNR
-      CSGNI = -CSGNI
-  120 CONTINUE
-      ZTI = -FMM
-      RTOL = 1.0D0/TOL
-      ASCLE = UFL*RTOL
-      DO 130 I=1,NN
-C       STR = CYR(I)*ZNR - CYI(I)*ZNI
-C       CYI(I) = CYR(I)*ZNI + CYI(I)*ZNR
-C       CYR(I) = STR
-C       STR = -ZNI*ZTI
-C       ZNI = ZNR*ZTI
-C       ZNR = STR
-        AA = CYR(I)
-        BB = CYI(I)
-        ATOL = 1.0D0
-        IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 135
-          AA = AA*RTOL
-          BB = BB*RTOL
-          ATOL = TOL
-  135 CONTINUE
-      STR = AA*CSGNR - BB*CSGNI
-      STI = AA*CSGNI + BB*CSGNR
-      CYR(I) = STR*ATOL
-      CYI(I) = STI*ATOL
-      STR = -CSGNI*ZTI
-      CSGNI = CSGNR*ZTI
-      CSGNR = STR
-  130 CONTINUE
-      RETURN
-  140 CONTINUE
-      IF (ZNR.LT.0.0D0) GO TO 230
-      RETURN
-  230 CONTINUE
-      NZ=0
-      IERR=2
-      RETURN
-  240 CONTINUE
-      IF(NW.EQ.(-1)) GO TO 230
-      NZ=0
-      IERR=5
-      RETURN
-  260 CONTINUE
-      NZ=0
-      IERR=4
-      RETURN
-      END

amos/zbesi.f

@@ -1,269 +0,0 @@
-      SUBROUTINE ZBESI(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, IERR)
-C***BEGIN PROLOGUE  ZBESI
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  890801   (YYMMDD)
-C***CATEGORY NO.  B5K
-C***KEYWORDS  I-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION,
-C             MODIFIED BESSEL FUNCTION OF THE FIRST KIND
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE I-BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C***DESCRIPTION
-C
-C                    ***A DOUBLE PRECISION ROUTINE***
-C         ON KODE=1, ZBESI COMPUTES AN N MEMBER SEQUENCE OF COMPLEX
-C         BESSEL FUNCTIONS CY(J)=I(FNU+J-1,Z) FOR REAL, NONNEGATIVE
-C         ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z IN THE CUT PLANE
-C         -PI.LT.ARG(Z).LE.PI. ON KODE=2, ZBESI RETURNS THE SCALED
-C         FUNCTIONS
-C
-C         CY(J)=EXP(-ABS(X))*I(FNU+J-1,Z)   J = 1,...,N , X=REAL(Z)
-C
-C         WITH THE EXPONENTIAL GROWTH REMOVED IN BOTH THE LEFT AND
-C         RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION
-C         ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS
-C         (REF. 1).
-C
-C         INPUT      ZR,ZI,FNU ARE DOUBLE PRECISION
-C           ZR,ZI  - Z=CMPLX(ZR,ZI),  -PI.LT.ARG(Z).LE.PI
-C           FNU    - ORDER OF INITIAL I FUNCTION, FNU.GE.0.0D0
-C           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION
-C                    KODE= 1  RETURNS
-C                             CY(J)=I(FNU+J-1,Z), J=1,...,N
-C                        = 2  RETURNS
-C                             CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X)), J=1,...,N
-C           N      - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1
-C
-C         OUTPUT     CYR,CYI ARE DOUBLE PRECISION
-C           CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS
-C                    CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE
-C                    CY(J)=I(FNU+J-1,Z)  OR
-C                    CY(J)=I(FNU+J-1,Z)*EXP(-ABS(X))  J=1,...,N
-C                    DEPENDING ON KODE, X=REAL(Z)
-C           NZ     - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW,
-C                    NZ= 0   , NORMAL RETURN
-C                    NZ.GT.0 , LAST NZ COMPONENTS OF CY SET TO ZERO
-C                              TO UNDERFLOW, CY(J)=CMPLX(0.0D0,0.0D0)
-C                              J = N-NZ+1,...,N
-C           IERR   - ERROR FLAG
-C                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED
-C                    IERR=1, INPUT ERROR   - NO COMPUTATION
-C                    IERR=2, OVERFLOW      - NO COMPUTATION, REAL(Z) TOO
-C                            LARGE ON KODE=1
-C                    IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE
-C                            BUT LOSSES OF SIGNIFCANCE BY ARGUMENT
-C                            REDUCTION PRODUCE LESS THAN HALF OF MACHINE
-C                            ACCURACY
-C                    IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA-
-C                            TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI-
-C                            CANCE BY ARGUMENT REDUCTION
-C                    IERR=5, ERROR              - NO COMPUTATION,
-C                            ALGORITHM TERMINATION CONDITION NOT MET
-C
-C***LONG DESCRIPTION
-C
-C         THE COMPUTATION IS CARRIED OUT BY THE POWER SERIES FOR
-C         SMALL CABS(Z), THE ASYMPTOTIC EXPANSION FOR LARGE CABS(Z),
-C         THE MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN AND A
-C         NEUMANN SERIES FOR IMTERMEDIATE MAGNITUDES, AND THE
-C         UNIFORM ASYMPTOTIC EXPANSIONS FOR I(FNU,Z) AND J(FNU,Z)
-C         FOR LARGE ORDERS. BACKWARD RECURRENCE IS USED TO GENERATE
-C         SEQUENCES OR REDUCE ORDERS WHEN NECESSARY.
-C
-C         THE CALCULATIONS ABOVE ARE DONE IN THE RIGHT HALF PLANE AND
-C         CONTINUED INTO THE LEFT HALF PLANE BY THE FORMULA
-C
-C         I(FNU,Z*EXP(M*PI)) = EXP(M*PI*FNU)*I(FNU,Z)  REAL(Z).GT.0.0
-C                       M = +I OR -I,  I**2=-1
-C
-C         FOR NEGATIVE ORDERS,THE FORMULA
-C
-C              I(-FNU,Z) = I(FNU,Z) + (2/PI)*SIN(PI*FNU)*K(FNU,Z)
-C
-C         CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE
-C         THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE
-C         INTEGER,THE MAGNITUDE OF I(-FNU,Z)=I(FNU,Z) IS A LARGE
-C         NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER,
-C         K(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF
-C         TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY
-C         UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN
-C         OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE,
-C         LARGE MEANS FNU.GT.CABS(Z).
-C
-C         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE-
-C         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS
-C         LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR.
-C         CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN
-C         LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG
-C         IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS
-C         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION.
-C         IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS
-C         LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS
-C         MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE
-C         INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS
-C         RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3
-C         ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION
-C         ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION
-C         ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN
-C         THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT
-C         TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS
-C         IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC.
-C         SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES.
-C
-C         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX
-C         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT
-C         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE-
-C         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE
-C         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))),
-C         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF
-C         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY
-C         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN
-C         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY
-C         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER
-C         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K,
-C         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS
-C         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER
-C         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY
-C         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER
-C         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE
-C         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES,
-C         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P,
-C         OR -PI/2+P.
-C
-C***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ
-C                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF
-C                 COMMERCE, 1955.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 BY D. E. AMOS, SAND83-0083, MAY, 1983.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983
-C
-C               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85-
-C                 1018, MAY, 1985
-C
-C               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS.
-C                 MATH. SOFTWARE, 1986
-C
-C***ROUTINES CALLED  ZBINU,I1MACH,D1MACH
-C***END PROLOGUE  ZBESI
-C     COMPLEX CONE,CSGN,CW,CY,CZERO,Z,ZN
-      DOUBLE PRECISION AA, ALIM, ARG, CONEI, CONER, CSGNI, CSGNR, CYI,
-     * CYR, DIG, ELIM, FNU, FNUL, PI, RL, R1M5, STR, TOL, ZI, ZNI, ZNR,
-     * ZR, D1MACH, AZ, BB, FN, ZABS, ASCLE, RTOL, ATOL, STI
-      INTEGER I, IERR, INU, K, KODE, K1,K2,N,NZ,NN, I1MACH
-      DIMENSION CYR(N), CYI(N)
-      DATA PI /3.14159265358979324D0/
-      DATA CONER, CONEI /1.0D0,0.0D0/
-C
-C***FIRST EXECUTABLE STATEMENT  ZBESI
-      IERR = 0
-      NZ=0
-      IF (FNU.LT.0.0D0) IERR=1
-      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
-      IF (N.LT.1) IERR=1
-      IF (IERR.NE.0) RETURN
-C-----------------------------------------------------------------------
-C     SET PARAMETERS RELATED TO MACHINE CONSTANTS.
-C     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18.
-C     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
-C     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND
-C     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR
-C     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
-C     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
-C     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
-C     FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU.
-C-----------------------------------------------------------------------
-      TOL = DMAX1(D1MACH(4),1.0D-18)
-      K1 = I1MACH(15)
-      K2 = I1MACH(16)
-      R1M5 = D1MACH(5)
-      K = MIN0(IABS(K1),IABS(K2))
-      ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0)
-      K1 = I1MACH(14) - 1
-      AA = R1M5*DBLE(FLOAT(K1))
-      DIG = DMIN1(AA,18.0D0)
-      AA = AA*2.303D0
-      ALIM = ELIM + DMAX1(-AA,-41.45D0)
-      RL = 1.2D0*DIG + 3.0D0
-      FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0)
-C-----------------------------------------------------------------------------
-C     TEST FOR PROPER RANGE
-C-----------------------------------------------------------------------
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      FN = FNU+DBLE(FLOAT(N-1))
-      AA = 0.5D0/TOL
-      BB=DBLE(FLOAT(I1MACH(9)))*0.5D0
-      AA = DMIN1(AA,BB)
-      IF (AZ.GT.AA) GO TO 260
-      IF (FN.GT.AA) GO TO 260
-      AA = DSQRT(AA)
-      IF (AZ.GT.AA) IERR=3
-      IF (FN.GT.AA) IERR=3
-      ZNR = ZR
-      ZNI = ZI
-      CSGNR = CONER
-      CSGNI = CONEI
-      IF (ZR.GE.0.0D0) GO TO 40
-      ZNR = -ZR
-      ZNI = -ZI
-C-----------------------------------------------------------------------
-C     CALCULATE CSGN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE
-C     WHEN FNU IS LARGE
-C-----------------------------------------------------------------------
-      INU = INT(SNGL(FNU))
-      ARG = (FNU-DBLE(FLOAT(INU)))*PI
-      IF (ZI.LT.0.0D0) ARG = -ARG
-      CSGNR = DCOS(ARG)
-      CSGNI = DSIN(ARG)
-      IF (MOD(INU,2).EQ.0) GO TO 40
-      CSGNR = -CSGNR
-      CSGNI = -CSGNI
-   40 CONTINUE
-      CALL ZBINU(ZNR, ZNI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL, TOL,
-     * ELIM, ALIM)
-      IF (NZ.LT.0) GO TO 120
-      IF (ZR.GE.0.0D0) RETURN
-C-----------------------------------------------------------------------
-C     ANALYTIC CONTINUATION TO THE LEFT HALF PLANE
-C-----------------------------------------------------------------------
-      NN = N - NZ
-      IF (NN.EQ.0) RETURN
-      RTOL = 1.0D0/TOL
-      ASCLE = D1MACH(1)*RTOL*1.0D+3
-      DO 50 I=1,NN
-C       STR = CYR(I)*CSGNR - CYI(I)*CSGNI
-C       CYI(I) = CYR(I)*CSGNI + CYI(I)*CSGNR
-C       CYR(I) = STR
-        AA = CYR(I)
-        BB = CYI(I)
-        ATOL = 1.0D0
-        IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 55
-          AA = AA*RTOL
-          BB = BB*RTOL
-          ATOL = TOL
-   55   CONTINUE
-        STR = AA*CSGNR - BB*CSGNI
-        STI = AA*CSGNI + BB*CSGNR
-        CYR(I) = STR*ATOL
-        CYI(I) = STI*ATOL
-        CSGNR = -CSGNR
-        CSGNI = -CSGNI
-   50 CONTINUE
-      RETURN
-  120 CONTINUE
-      IF(NZ.EQ.(-2)) GO TO 130
-      NZ = 0
-      IERR=2
-      RETURN
-  130 CONTINUE
-      NZ=0
-      IERR=5
-      RETURN
-  260 CONTINUE
-      NZ=0
-      IERR=4
-      RETURN
-      END

amos/zbesj.f

@@ -1,266 +0,0 @@
-      SUBROUTINE ZBESJ(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, IERR)
-C***BEGIN PROLOGUE  ZBESJ
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  890801   (YYMMDD)
-C***CATEGORY NO.  B5K
-C***KEYWORDS  J-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT,
-C             BESSEL FUNCTION OF FIRST KIND
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE THE J-BESSEL FUNCTION OF A COMPLEX ARGUMENT
-C***DESCRIPTION
-C
-C                      ***A DOUBLE PRECISION ROUTINE***
-C         ON KODE=1, CBESJ COMPUTES AN N MEMBER  SEQUENCE OF COMPLEX
-C         BESSEL FUNCTIONS CY(I)=J(FNU+I-1,Z) FOR REAL, NONNEGATIVE
-C         ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE
-C         -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESJ RETURNS THE SCALED
-C         FUNCTIONS
-C
-C         CY(I)=EXP(-ABS(Y))*J(FNU+I-1,Z)   I = 1,...,N , Y=AIMAG(Z)
-C
-C         WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND
-C         LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION
-C         ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS
-C         (REF. 1).
-C
-C         INPUT      ZR,ZI,FNU ARE DOUBLE PRECISION
-C           ZR,ZI  - Z=CMPLX(ZR,ZI),  -PI.LT.ARG(Z).LE.PI
-C           FNU    - ORDER OF INITIAL J FUNCTION, FNU.GE.0.0D0
-C           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION
-C                    KODE= 1  RETURNS
-C                             CY(I)=J(FNU+I-1,Z), I=1,...,N
-C                        = 2  RETURNS
-C                             CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y)), I=1,...,N
-C           N      - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1
-C
-C         OUTPUT     CYR,CYI ARE DOUBLE PRECISION
-C           CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS
-C                    CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE
-C                    CY(I)=J(FNU+I-1,Z)  OR
-C                    CY(I)=J(FNU+I-1,Z)EXP(-ABS(Y))  I=1,...,N
-C                    DEPENDING ON KODE, Y=AIMAG(Z).
-C           NZ     - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW,
-C                    NZ= 0   , NORMAL RETURN
-C                    NZ.GT.0 , LAST NZ COMPONENTS OF CY SET  ZERO DUE
-C                              TO UNDERFLOW, CY(I)=CMPLX(0.0D0,0.0D0),
-C                              I = N-NZ+1,...,N
-C           IERR   - ERROR FLAG
-C                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED
-C                    IERR=1, INPUT ERROR   - NO COMPUTATION
-C                    IERR=2, OVERFLOW      - NO COMPUTATION, AIMAG(Z)
-C                            TOO LARGE ON KODE=1
-C                    IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE
-C                            BUT LOSSES OF SIGNIFCANCE BY ARGUMENT
-C                            REDUCTION PRODUCE LESS THAN HALF OF MACHINE
-C                            ACCURACY
-C                    IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA-
-C                            TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI-
-C                            CANCE BY ARGUMENT REDUCTION
-C                    IERR=5, ERROR              - NO COMPUTATION,
-C                            ALGORITHM TERMINATION CONDITION NOT MET
-C
-C***LONG DESCRIPTION
-C
-C         THE COMPUTATION IS CARRIED OUT BY THE FORMULA
-C
-C         J(FNU,Z)=EXP( FNU*PI*I/2)*I(FNU,-I*Z)    AIMAG(Z).GE.0.0
-C
-C         J(FNU,Z)=EXP(-FNU*PI*I/2)*I(FNU, I*Z)    AIMAG(Z).LT.0.0
-C
-C         WHERE I**2 = -1 AND I(FNU,Z) IS THE I BESSEL FUNCTION.
-C
-C         FOR NEGATIVE ORDERS,THE FORMULA
-C
-C              J(-FNU,Z) = J(FNU,Z)*COS(PI*FNU) - Y(FNU,Z)*SIN(PI*FNU)
-C
-C         CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO INTEGERS, THE
-C         THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE POSITIVE
-C         INTEGER,THE MAGNITUDE OF J(-FNU,Z)=J(FNU,Z)*COS(PI*FNU) IS A
-C         LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS NOT AN INTEGER,
-C         Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A LARGE POSITIVE POWER OF
-C         TEN AND THE MOST THAT THE SECOND TERM CAN BE REDUCED IS BY
-C         UNIT ROUNDOFF FROM THE COEFFICIENT. THUS, WIDE CHANGES CAN
-C         OCCUR WITHIN UNIT ROUNDOFF OF A LARGE INTEGER FOR FNU. HERE,
-C         LARGE MEANS FNU.GT.CABS(Z).
-C
-C         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE-
-C         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS
-C         LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR.
-C         CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN
-C         LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG
-C         IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS
-C         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION.
-C         IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS
-C         LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS
-C         MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE
-C         INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS
-C         RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3
-C         ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION
-C         ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION
-C         ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN
-C         THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT
-C         TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS
-C         IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC.
-C         SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES.
-C
-C         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX
-C         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT
-C         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE-
-C         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE
-C         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))),
-C         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF
-C         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY
-C         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN
-C         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY
-C         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER
-C         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K,
-C         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS
-C         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER
-C         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY
-C         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER
-C         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE
-C         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES,
-C         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P,
-C         OR -PI/2+P.
-C
-C***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ
-C                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF
-C                 COMMERCE, 1955.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 BY D. E. AMOS, SAND83-0083, MAY, 1983.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983
-C
-C               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85-
-C                 1018, MAY, 1985
-C
-C               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS.
-C                 MATH. SOFTWARE, 1986
-C
-C***ROUTINES CALLED  ZBINU,I1MACH,D1MACH
-C***END PROLOGUE  ZBESJ
-C
-C     COMPLEX CI,CSGN,CY,Z,ZN
-      DOUBLE PRECISION AA, ALIM, ARG, CII, CSGNI, CSGNR, CYI, CYR, DIG,
-     * ELIM, FNU, FNUL, HPI, RL, R1M5, STR, TOL, ZI, ZNI, ZNR, ZR,
-     * D1MACH, BB, FN, AZ, ZABS, ASCLE, RTOL, ATOL, STI
-      INTEGER I, IERR, INU, INUH, IR, K, KODE, K1, K2, N, NL, NZ, I1MACH
-      DIMENSION CYR(N), CYI(N)
-      DATA HPI /1.57079632679489662D0/
-C
-C***FIRST EXECUTABLE STATEMENT  ZBESJ
-      IERR = 0
-      NZ=0
-      IF (FNU.LT.0.0D0) IERR=1
-      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
-      IF (N.LT.1) IERR=1
-      IF (IERR.NE.0) RETURN
-C-----------------------------------------------------------------------
-C     SET PARAMETERS RELATED TO MACHINE CONSTANTS.
-C     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18.
-C     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
-C     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND
-C     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR
-C     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
-C     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
-C     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
-C     FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU.
-C-----------------------------------------------------------------------
-      TOL = DMAX1(D1MACH(4),1.0D-18)
-      K1 = I1MACH(15)
-      K2 = I1MACH(16)
-      R1M5 = D1MACH(5)
-      K = MIN0(IABS(K1),IABS(K2))
-      ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0)
-      K1 = I1MACH(14) - 1
-      AA = R1M5*DBLE(FLOAT(K1))
-      DIG = DMIN1(AA,18.0D0)
-      AA = AA*2.303D0
-      ALIM = ELIM + DMAX1(-AA,-41.45D0)
-      RL = 1.2D0*DIG + 3.0D0
-      FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0)
-C-----------------------------------------------------------------------
-C     TEST FOR PROPER RANGE
-C-----------------------------------------------------------------------
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      FN = FNU+DBLE(FLOAT(N-1))
-      AA = 0.5D0/TOL
-      BB=DBLE(FLOAT(I1MACH(9)))*0.5D0
-      AA = DMIN1(AA,BB)
-      IF (AZ.GT.AA) GO TO 260
-      IF (FN.GT.AA) GO TO 260
-      AA = DSQRT(AA)
-      IF (AZ.GT.AA) IERR=3
-      IF (FN.GT.AA) IERR=3
-C-----------------------------------------------------------------------
-C     CALCULATE CSGN=EXP(FNU*HPI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE
-C     WHEN FNU IS LARGE
-C-----------------------------------------------------------------------
-      CII = 1.0D0
-      INU = INT(SNGL(FNU))
-      INUH = INU/2
-      IR = INU - 2*INUH
-      ARG = (FNU-DBLE(FLOAT(INU-IR)))*HPI
-      CSGNR = DCOS(ARG)
-      CSGNI = DSIN(ARG)
-      IF (MOD(INUH,2).EQ.0) GO TO 40
-      CSGNR = -CSGNR
-      CSGNI = -CSGNI
-   40 CONTINUE
-C-----------------------------------------------------------------------
-C     ZN IS IN THE RIGHT HALF PLANE
-C-----------------------------------------------------------------------
-      ZNR = ZI
-      ZNI = -ZR
-      IF (ZI.GE.0.0D0) GO TO 50
-      ZNR = -ZNR
-      ZNI = -ZNI
-      CSGNI = -CSGNI
-      CII = -CII
-   50 CONTINUE
-      CALL ZBINU(ZNR, ZNI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL, TOL,
-     * ELIM, ALIM)
-      IF (NZ.LT.0) GO TO 130
-      NL = N - NZ
-      IF (NL.EQ.0) RETURN
-      RTOL = 1.0D0/TOL
-      ASCLE = D1MACH(1)*RTOL*1.0D+3
-      DO 60 I=1,NL
-C       STR = CYR(I)*CSGNR - CYI(I)*CSGNI
-C       CYI(I) = CYR(I)*CSGNI + CYI(I)*CSGNR
-C       CYR(I) = STR
-        AA = CYR(I)
-        BB = CYI(I)
-        ATOL = 1.0D0
-        IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 55
-          AA = AA*RTOL
-          BB = BB*RTOL
-          ATOL = TOL
-   55   CONTINUE
-        STR = AA*CSGNR - BB*CSGNI
-        STI = AA*CSGNI + BB*CSGNR
-        CYR(I) = STR*ATOL
-        CYI(I) = STI*ATOL
-        STR = -CSGNI*CII
-        CSGNI = CSGNR*CII
-        CSGNR = STR
-   60 CONTINUE
-      RETURN
-  130 CONTINUE
-      IF(NZ.EQ.(-2)) GO TO 140
-      NZ = 0
-      IERR = 2
-      RETURN
-  140 CONTINUE
-      NZ=0
-      IERR=5
-      RETURN
-  260 CONTINUE
-      NZ=0
-      IERR=4
-      RETURN
-      END

amos/zbesk.f

@@ -1,281 +0,0 @@
-      SUBROUTINE ZBESK(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, IERR)
-C***BEGIN PROLOGUE  ZBESK
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  890801   (YYMMDD)
-C***CATEGORY NO.  B5K
-C***KEYWORDS  K-BESSEL FUNCTION,COMPLEX BESSEL FUNCTION,
-C             MODIFIED BESSEL FUNCTION OF THE SECOND KIND,
-C             BESSEL FUNCTION OF THE THIRD KIND
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE K-BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C***DESCRIPTION
-C
-C                      ***A DOUBLE PRECISION ROUTINE***
-C
-C         ON KODE=1, CBESK COMPUTES AN N MEMBER SEQUENCE OF COMPLEX
-C         BESSEL FUNCTIONS CY(J)=K(FNU+J-1,Z) FOR REAL, NONNEGATIVE
-C         ORDERS FNU+J-1, J=1,...,N AND COMPLEX Z.NE.CMPLX(0.0,0.0)
-C         IN THE CUT PLANE -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESK
-C         RETURNS THE SCALED K FUNCTIONS,
-C
-C         CY(J)=EXP(Z)*K(FNU+J-1,Z) , J=1,...,N,
-C
-C         WHICH REMOVE THE EXPONENTIAL BEHAVIOR IN BOTH THE LEFT AND
-C         RIGHT HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND
-C         NOTATION ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL
-C         FUNCTIONS (REF. 1).
-C
-C         INPUT      ZR,ZI,FNU ARE DOUBLE PRECISION
-C           ZR,ZI  - Z=CMPLX(ZR,ZI), Z.NE.CMPLX(0.0D0,0.0D0),
-C                    -PI.LT.ARG(Z).LE.PI
-C           FNU    - ORDER OF INITIAL K FUNCTION, FNU.GE.0.0D0
-C           N      - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1
-C           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION
-C                    KODE= 1  RETURNS
-C                             CY(I)=K(FNU+I-1,Z), I=1,...,N
-C                        = 2  RETURNS
-C                             CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N
-C
-C         OUTPUT     CYR,CYI ARE DOUBLE PRECISION
-C           CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS
-C                    CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE
-C                    CY(I)=K(FNU+I-1,Z), I=1,...,N OR
-C                    CY(I)=K(FNU+I-1,Z)*EXP(Z), I=1,...,N
-C                    DEPENDING ON KODE
-C           NZ     - NUMBER OF COMPONENTS SET TO ZERO DUE TO UNDERFLOW.
-C                    NZ= 0   , NORMAL RETURN
-C                    NZ.GT.0 , FIRST NZ COMPONENTS OF CY SET TO ZERO DUE
-C                              TO UNDERFLOW, CY(I)=CMPLX(0.0D0,0.0D0),
-C                              I=1,...,N WHEN X.GE.0.0. WHEN X.LT.0.0
-C                              NZ STATES ONLY THE NUMBER OF UNDERFLOWS
-C                              IN THE SEQUENCE.
-C
-C           IERR   - ERROR FLAG
-C                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED
-C                    IERR=1, INPUT ERROR   - NO COMPUTATION
-C                    IERR=2, OVERFLOW      - NO COMPUTATION, FNU IS
-C                            TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH
-C                    IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE
-C                            BUT LOSSES OF SIGNIFCANCE BY ARGUMENT
-C                            REDUCTION PRODUCE LESS THAN HALF OF MACHINE
-C                            ACCURACY
-C                    IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA-
-C                            TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI-
-C                            CANCE BY ARGUMENT REDUCTION
-C                    IERR=5, ERROR              - NO COMPUTATION,
-C                            ALGORITHM TERMINATION CONDITION NOT MET
-C
-C***LONG DESCRIPTION
-C
-C         EQUATIONS OF THE REFERENCE ARE IMPLEMENTED FOR SMALL ORDERS
-C         DNU AND DNU+1.0 IN THE RIGHT HALF PLANE X.GE.0.0. FORWARD
-C         RECURRENCE GENERATES HIGHER ORDERS. K IS CONTINUED TO THE LEFT
-C         HALF PLANE BY THE RELATION
-C
-C         K(FNU,Z*EXP(MP)) = EXP(-MP*FNU)*K(FNU,Z)-MP*I(FNU,Z)
-C         MP=MR*PI*I, MR=+1 OR -1, RE(Z).GT.0, I**2=-1
-C
-C         WHERE I(FNU,Z) IS THE I BESSEL FUNCTION.
-C
-C         FOR LARGE ORDERS, FNU.GT.FNUL, THE K FUNCTION IS COMPUTED
-C         BY MEANS OF ITS UNIFORM ASYMPTOTIC EXPANSIONS.
-C
-C         FOR NEGATIVE ORDERS, THE FORMULA
-C
-C                       K(-FNU,Z) = K(FNU,Z)
-C
-C         CAN BE USED.
-C
-C         CBESK ASSUMES THAT A SIGNIFICANT DIGIT SINH(X) FUNCTION IS
-C         AVAILABLE.
-C
-C         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE-
-C         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS
-C         LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR.
-C         CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN
-C         LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG
-C         IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS
-C         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION.
-C         IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS
-C         LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS
-C         MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE
-C         INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS
-C         RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3
-C         ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION
-C         ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION
-C         ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN
-C         THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT
-C         TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS
-C         IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC.
-C         SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES.
-C
-C         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX
-C         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT
-C         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE-
-C         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE
-C         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))),
-C         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF
-C         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY
-C         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN
-C         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY
-C         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER
-C         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K,
-C         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS
-C         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER
-C         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY
-C         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER
-C         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE
-C         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES,
-C         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P,
-C         OR -PI/2+P.
-C
-C***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ
-C                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF
-C                 COMMERCE, 1955.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 BY D. E. AMOS, SAND83-0083, MAY, 1983.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983.
-C
-C               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85-
-C                 1018, MAY, 1985
-C
-C               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS.
-C                 MATH. SOFTWARE, 1986
-C
-C***ROUTINES CALLED  ZACON,ZBKNU,ZBUNK,ZUOIK,ZABS,I1MACH,D1MACH
-C***END PROLOGUE  ZBESK
-C
-C     COMPLEX CY,Z
-      DOUBLE PRECISION AA, ALIM, ALN, ARG, AZ, CYI, CYR, DIG, ELIM, FN,
-     * FNU, FNUL, RL, R1M5, TOL, UFL, ZI, ZR, D1MACH, ZABS, BB
-      INTEGER IERR, K, KODE, K1, K2, MR, N, NN, NUF, NW, NZ, I1MACH
-      DIMENSION CYR(N), CYI(N)
-C***FIRST EXECUTABLE STATEMENT  ZBESK
-      IERR = 0
-      NZ=0
-      IF (ZI.EQ.0.0E0 .AND. ZR.EQ.0.0E0) IERR=1
-      IF (FNU.LT.0.0D0) IERR=1
-      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
-      IF (N.LT.1) IERR=1
-      IF (IERR.NE.0) RETURN
-      NN = N
-C-----------------------------------------------------------------------
-C     SET PARAMETERS RELATED TO MACHINE CONSTANTS.
-C     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18.
-C     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
-C     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND
-C     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR
-C     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
-C     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
-C     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
-C     FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU
-C-----------------------------------------------------------------------
-      TOL = DMAX1(D1MACH(4),1.0D-18)
-      K1 = I1MACH(15)
-      K2 = I1MACH(16)
-      R1M5 = D1MACH(5)
-      K = MIN0(IABS(K1),IABS(K2))
-      ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0)
-      K1 = I1MACH(14) - 1
-      AA = R1M5*DBLE(FLOAT(K1))
-      DIG = DMIN1(AA,18.0D0)
-      AA = AA*2.303D0
-      ALIM = ELIM + DMAX1(-AA,-41.45D0)
-      FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0)
-      RL = 1.2D0*DIG + 3.0D0
-C-----------------------------------------------------------------------------
-C     TEST FOR PROPER RANGE
-C-----------------------------------------------------------------------
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      FN = FNU + DBLE(FLOAT(NN-1))
-      AA = 0.5D0/TOL
-      BB=DBLE(FLOAT(I1MACH(9)))*0.5D0
-      AA = DMIN1(AA,BB)
-      IF (AZ.GT.AA) GO TO 260
-      IF (FN.GT.AA) GO TO 260
-      AA = DSQRT(AA)
-      IF (AZ.GT.AA) IERR=3
-      IF (FN.GT.AA) IERR=3
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST ON THE LAST MEMBER OF THE SEQUENCE
-C-----------------------------------------------------------------------
-C     UFL = DEXP(-ELIM)
-      UFL = D1MACH(1)*1.0D+3
-      IF (AZ.LT.UFL) GO TO 180
-      IF (FNU.GT.FNUL) GO TO 80
-      IF (FN.LE.1.0D0) GO TO 60
-      IF (FN.GT.2.0D0) GO TO 50
-      IF (AZ.GT.TOL) GO TO 60
-      ARG = 0.5D0*AZ
-      ALN = -FN*DLOG(ARG)
-      IF (ALN.GT.ELIM) GO TO 180
-      GO TO 60
-   50 CONTINUE
-      CALL ZUOIK(ZR, ZI, FNU, KODE, 2, NN, CYR, CYI, NUF, TOL, ELIM,
-     * ALIM)
-      IF (NUF.LT.0) GO TO 180
-      NZ = NZ + NUF
-      NN = NN - NUF
-C-----------------------------------------------------------------------
-C     HERE NN=N OR NN=0 SINCE NUF=0,NN, OR -1 ON RETURN FROM CUOIK
-C     IF NUF=NN, THEN CY(I)=CZERO FOR ALL I
-C-----------------------------------------------------------------------
-      IF (NN.EQ.0) GO TO 100
-   60 CONTINUE
-      IF (ZR.LT.0.0D0) GO TO 70
-C-----------------------------------------------------------------------
-C     RIGHT HALF PLANE COMPUTATION, REAL(Z).GE.0.
-C-----------------------------------------------------------------------
-      CALL ZBKNU(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM)
-      IF (NW.LT.0) GO TO 200
-      NZ=NW
-      RETURN
-C-----------------------------------------------------------------------
-C     LEFT HALF PLANE COMPUTATION
-C     PI/2.LT.ARG(Z).LE.PI AND -PI.LT.ARG(Z).LT.-PI/2.
-C-----------------------------------------------------------------------
-   70 CONTINUE
-      IF (NZ.NE.0) GO TO 180
-      MR = 1
-      IF (ZI.LT.0.0D0) MR = -1
-      CALL ZACON(ZR, ZI, FNU, KODE, MR, NN, CYR, CYI, NW, RL, FNUL,
-     * TOL, ELIM, ALIM)
-      IF (NW.LT.0) GO TO 200
-      NZ=NW
-      RETURN
-C-----------------------------------------------------------------------
-C     UNIFORM ASYMPTOTIC EXPANSIONS FOR FNU.GT.FNUL
-C-----------------------------------------------------------------------
-   80 CONTINUE
-      MR = 0
-      IF (ZR.GE.0.0D0) GO TO 90
-      MR = 1
-      IF (ZI.LT.0.0D0) MR = -1
-   90 CONTINUE
-      CALL ZBUNK(ZR, ZI, FNU, KODE, MR, NN, CYR, CYI, NW, TOL, ELIM,
-     * ALIM)
-      IF (NW.LT.0) GO TO 200
-      NZ = NZ + NW
-      RETURN
-  100 CONTINUE
-      IF (ZR.LT.0.0D0) GO TO 180
-      RETURN
-  180 CONTINUE
-      NZ = 0
-      IERR=2
-      RETURN
-  200 CONTINUE
-      IF(NW.EQ.(-1)) GO TO 180
-      NZ=0
-      IERR=5
-      RETURN
-  260 CONTINUE
-      NZ=0
-      IERR=4
-      RETURN
-      END

amos/zbesy.f

@@ -1,244 +0,0 @@
-      SUBROUTINE ZBESY(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, CWRKR, CWRKI,
-     *                 IERR)
-C***BEGIN PROLOGUE  ZBESY
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  890801   (YYMMDD)
-C***CATEGORY NO.  B5K
-C***KEYWORDS  Y-BESSEL FUNCTION,BESSEL FUNCTION OF COMPLEX ARGUMENT,
-C             BESSEL FUNCTION OF SECOND KIND
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE THE Y-BESSEL FUNCTION OF A COMPLEX ARGUMENT
-C***DESCRIPTION
-C
-C                      ***A DOUBLE PRECISION ROUTINE***
-C
-C         ON KODE=1, CBESY COMPUTES AN N MEMBER SEQUENCE OF COMPLEX
-C         BESSEL FUNCTIONS CY(I)=Y(FNU+I-1,Z) FOR REAL, NONNEGATIVE
-C         ORDERS FNU+I-1, I=1,...,N AND COMPLEX Z IN THE CUT PLANE
-C         -PI.LT.ARG(Z).LE.PI. ON KODE=2, CBESY RETURNS THE SCALED
-C         FUNCTIONS
-C
-C         CY(I)=EXP(-ABS(Y))*Y(FNU+I-1,Z)   I = 1,...,N , Y=AIMAG(Z)
-C
-C         WHICH REMOVE THE EXPONENTIAL GROWTH IN BOTH THE UPPER AND
-C         LOWER HALF PLANES FOR Z TO INFINITY. DEFINITIONS AND NOTATION
-C         ARE FOUND IN THE NBS HANDBOOK OF MATHEMATICAL FUNCTIONS
-C         (REF. 1).
-C
-C         INPUT      ZR,ZI,FNU ARE DOUBLE PRECISION
-C           ZR,ZI  - Z=CMPLX(ZR,ZI), Z.NE.CMPLX(0.0D0,0.0D0),
-C                    -PI.LT.ARG(Z).LE.PI
-C           FNU    - ORDER OF INITIAL Y FUNCTION, FNU.GE.0.0D0
-C           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION
-C                    KODE= 1  RETURNS
-C                             CY(I)=Y(FNU+I-1,Z), I=1,...,N
-C                        = 2  RETURNS
-C                             CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y)), I=1,...,N
-C                             WHERE Y=AIMAG(Z)
-C           N      - NUMBER OF MEMBERS OF THE SEQUENCE, N.GE.1
-C           CWRKR, - DOUBLE PRECISION WORK VECTORS OF DIMENSION AT
-C           CWRKI    AT LEAST N
-C
-C         OUTPUT     CYR,CYI ARE DOUBLE PRECISION
-C           CYR,CYI- DOUBLE PRECISION VECTORS WHOSE FIRST N COMPONENTS
-C                    CONTAIN REAL AND IMAGINARY PARTS FOR THE SEQUENCE
-C                    CY(I)=Y(FNU+I-1,Z)  OR
-C                    CY(I)=Y(FNU+I-1,Z)*EXP(-ABS(Y))  I=1,...,N
-C                    DEPENDING ON KODE.
-C           NZ     - NZ=0 , A NORMAL RETURN
-C                    NZ.GT.0 , NZ COMPONENTS OF CY SET TO ZERO DUE TO
-C                    UNDERFLOW (GENERALLY ON KODE=2)
-C           IERR   - ERROR FLAG
-C                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED
-C                    IERR=1, INPUT ERROR   - NO COMPUTATION
-C                    IERR=2, OVERFLOW      - NO COMPUTATION, FNU IS
-C                            TOO LARGE OR CABS(Z) IS TOO SMALL OR BOTH
-C                    IERR=3, CABS(Z) OR FNU+N-1 LARGE - COMPUTATION DONE
-C                            BUT LOSSES OF SIGNIFCANCE BY ARGUMENT
-C                            REDUCTION PRODUCE LESS THAN HALF OF MACHINE
-C                            ACCURACY
-C                    IERR=4, CABS(Z) OR FNU+N-1 TOO LARGE - NO COMPUTA-
-C                            TION BECAUSE OF COMPLETE LOSSES OF SIGNIFI-
-C                            CANCE BY ARGUMENT REDUCTION
-C                    IERR=5, ERROR              - NO COMPUTATION,
-C                            ALGORITHM TERMINATION CONDITION NOT MET
-C
-C***LONG DESCRIPTION
-C
-C         THE COMPUTATION IS CARRIED OUT BY THE FORMULA
-C
-C         Y(FNU,Z)=0.5*(H(1,FNU,Z)-H(2,FNU,Z))/I
-C
-C         WHERE I**2 = -1 AND THE HANKEL BESSEL FUNCTIONS H(1,FNU,Z)
-C         AND H(2,FNU,Z) ARE CALCULATED IN CBESH.
-C
-C         FOR NEGATIVE ORDERS,THE FORMULA
-C
-C              Y(-FNU,Z) = Y(FNU,Z)*COS(PI*FNU) + J(FNU,Z)*SIN(PI*FNU)
-C
-C         CAN BE USED. HOWEVER,FOR LARGE ORDERS CLOSE TO HALF ODD
-C         INTEGERS THE FUNCTION CHANGES RADICALLY. WHEN FNU IS A LARGE
-C         POSITIVE HALF ODD INTEGER,THE MAGNITUDE OF Y(-FNU,Z)=J(FNU,Z)*
-C         SIN(PI*FNU) IS A LARGE NEGATIVE POWER OF TEN. BUT WHEN FNU IS
-C         NOT A HALF ODD INTEGER, Y(FNU,Z) DOMINATES IN MAGNITUDE WITH A
-C         LARGE POSITIVE POWER OF TEN AND THE MOST THAT THE SECOND TERM
-C         CAN BE REDUCED IS BY UNIT ROUNDOFF FROM THE COEFFICIENT. THUS,
-C         WIDE CHANGES CAN OCCUR WITHIN UNIT ROUNDOFF OF A LARGE HALF
-C         ODD INTEGER. HERE, LARGE MEANS FNU.GT.CABS(Z).
-C
-C         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE-
-C         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z OR FNU+N-1 IS
-C         LARGE, LOSSES OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR.
-C         CONSEQUENTLY, IF EITHER ONE EXCEEDS U1=SQRT(0.5/UR), THEN
-C         LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR FLAG
-C         IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS
-C         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION.
-C         IF EITHER IS LARGER THAN U2=0.5/UR, THEN ALL SIGNIFICANCE IS
-C         LOST AND IERR=4. IN ORDER TO USE THE INT FUNCTION, ARGUMENTS
-C         MUST BE FURTHER RESTRICTED NOT TO EXCEED THE LARGEST MACHINE
-C         INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF Z AND FNU+N-1 IS
-C         RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2, AND U3
-C         ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE PRECISION
-C         ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE PRECISION
-C         ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMITING IN
-C         THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT ONE CAN EXPECT
-C         TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES, NO DIGITS
-C         IN SINGLE AND ONLY 7 DIGITS IN DOUBLE PRECISION ARITHMETIC.
-C         SIMILAR CONSIDERATIONS HOLD FOR OTHER MACHINES.
-C
-C         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX
-C         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT
-C         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE-
-C         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE
-C         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))),
-C         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF
-C         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY
-C         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN
-C         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY
-C         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER
-C         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K,
-C         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS
-C         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER
-C         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY
-C         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER
-C         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE
-C         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES,
-C         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P,
-C         OR -PI/2+P.
-C
-C***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ
-C                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF
-C                 COMMERCE, 1955.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 BY D. E. AMOS, SAND83-0083, MAY, 1983.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983
-C
-C               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85-
-C                 1018, MAY, 1985
-C
-C               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS.
-C                 MATH. SOFTWARE, 1986
-C
-C***ROUTINES CALLED  ZBESH,I1MACH,D1MACH
-C***END PROLOGUE  ZBESY
-C
-C     COMPLEX CWRK,CY,C1,C2,EX,HCI,Z,ZU,ZV
-      DOUBLE PRECISION CWRKI, CWRKR, CYI, CYR, C1I, C1R, C2I, C2R,
-     * ELIM, EXI, EXR, EY, FNU, HCII, STI, STR, TAY, ZI, ZR, DEXP,
-     * D1MACH, ASCLE, RTOL, ATOL, AA, BB, TOL
-      INTEGER I, IERR, K, KODE, K1, K2, N, NZ, NZ1, NZ2, I1MACH
-      DIMENSION CYR(N), CYI(N), CWRKR(N), CWRKI(N)
-C***FIRST EXECUTABLE STATEMENT  ZBESY
-      IERR = 0
-      NZ=0
-      IF (ZR.EQ.0.0D0 .AND. ZI.EQ.0.0D0) IERR=1
-      IF (FNU.LT.0.0D0) IERR=1
-      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
-      IF (N.LT.1) IERR=1
-      IF (IERR.NE.0) RETURN
-      HCII = 0.5D0
-      CALL ZBESH(ZR, ZI, FNU, KODE, 1, N, CYR, CYI, NZ1, IERR)
-      IF (IERR.NE.0.AND.IERR.NE.3) GO TO 170
-      CALL ZBESH(ZR, ZI, FNU, KODE, 2, N, CWRKR, CWRKI, NZ2, IERR)
-      IF (IERR.NE.0.AND.IERR.NE.3) GO TO 170
-      NZ = MIN0(NZ1,NZ2)
-      IF (KODE.EQ.2) GO TO 60
-      DO 50 I=1,N
-        STR = CWRKR(I) - CYR(I)
-        STI = CWRKI(I) - CYI(I)
-        CYR(I) = -STI*HCII
-        CYI(I) = STR*HCII
-   50 CONTINUE
-      RETURN
-   60 CONTINUE
-      TOL = DMAX1(D1MACH(4),1.0D-18)
-      K1 = I1MACH(15)
-      K2 = I1MACH(16)
-      K = MIN0(IABS(K1),IABS(K2))
-      R1M5 = D1MACH(5)
-C-----------------------------------------------------------------------
-C     ELIM IS THE APPROXIMATE EXPONENTIAL UNDER- AND OVERFLOW LIMIT
-C-----------------------------------------------------------------------
-      ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0)
-      EXR = DCOS(ZR)
-      EXI = DSIN(ZR)
-      EY = 0.0D0
-      TAY = DABS(ZI+ZI)
-      IF (TAY.LT.ELIM) EY = DEXP(-TAY)
-      IF (ZI.LT.0.0D0) GO TO 90
-      C1R = EXR*EY
-      C1I = EXI*EY
-      C2R = EXR
-      C2I = -EXI
-   70 CONTINUE
-      NZ = 0
-      RTOL = 1.0D0/TOL
-      ASCLE = D1MACH(1)*RTOL*1.0D+3
-      DO 80 I=1,N
-C       STR = C1R*CYR(I) - C1I*CYI(I)
-C       STI = C1R*CYI(I) + C1I*CYR(I)
-C       STR = -STR + C2R*CWRKR(I) - C2I*CWRKI(I)
-C       STI = -STI + C2R*CWRKI(I) + C2I*CWRKR(I)
-C       CYR(I) = -STI*HCII
-C       CYI(I) = STR*HCII
-        AA = CWRKR(I)
-        BB = CWRKI(I)
-        ATOL = 1.0D0
-        IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 75
-          AA = AA*RTOL
-          BB = BB*RTOL
-          ATOL = TOL
-   75   CONTINUE
-        STR = (AA*C2R - BB*C2I)*ATOL
-        STI = (AA*C2I + BB*C2R)*ATOL
-        AA = CYR(I)
-        BB = CYI(I)
-        ATOL = 1.0D0
-        IF (DMAX1(DABS(AA),DABS(BB)).GT.ASCLE) GO TO 85
-          AA = AA*RTOL
-          BB = BB*RTOL
-          ATOL = TOL
-   85   CONTINUE
-        STR = STR - (AA*C1R - BB*C1I)*ATOL
-        STI = STI - (AA*C1I + BB*C1R)*ATOL
-        CYR(I) = -STI*HCII
-        CYI(I) =  STR*HCII
-        IF (STR.EQ.0.0D0 .AND. STI.EQ.0.0D0 .AND. EY.EQ.0.0D0) NZ = NZ
-     *   + 1
-   80 CONTINUE
-      RETURN
-   90 CONTINUE
-      C1R = EXR
-      C1I = EXI
-      C2R = EXR*EY
-      C2I = -EXI*EY
-      GO TO 70
-  170 CONTINUE
-      NZ = 0
-      RETURN
-      END

amos/zbinu.f

@@ -1,110 +0,0 @@
-      SUBROUTINE ZBINU(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL,
-     * TOL, ELIM, ALIM)
-C***BEGIN PROLOGUE  ZBINU
-C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZAIRY,ZBIRY
-C
-C     ZBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE
-C
-C***ROUTINES CALLED  ZABS,ZASYI,ZBUNI,ZMLRI,ZSERI,ZUOIK,ZWRSK
-C***END PROLOGUE  ZBINU
-      DOUBLE PRECISION ALIM, AZ, CWI, CWR, CYI, CYR, DFNU, ELIM, FNU,
-     * FNUL, RL, TOL, ZEROI, ZEROR, ZI, ZR, ZABS
-      INTEGER I, INW, KODE, N, NLAST, NN, NUI, NW, NZ
-      DIMENSION CYR(N), CYI(N), CWR(2), CWI(2)
-      DATA ZEROR,ZEROI / 0.0D0, 0.0D0 /
-C
-      NZ = 0
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      NN = N
-      DFNU = FNU + DBLE(FLOAT(N-1))
-      IF (AZ.LE.2.0D0) GO TO 10
-      IF (AZ*AZ*0.25D0.GT.DFNU+1.0D0) GO TO 20
-   10 CONTINUE
-C-----------------------------------------------------------------------
-C     POWER SERIES
-C-----------------------------------------------------------------------
-      CALL ZSERI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM)
-      INW = IABS(NW)
-      NZ = NZ + INW
-      NN = NN - INW
-      IF (NN.EQ.0) RETURN
-      IF (NW.GE.0) GO TO 120
-      DFNU = FNU + DBLE(FLOAT(NN-1))
-   20 CONTINUE
-      IF (AZ.LT.RL) GO TO 40
-      IF (DFNU.LE.1.0D0) GO TO 30
-      IF (AZ+AZ.LT.DFNU*DFNU) GO TO 50
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR LARGE Z
-C-----------------------------------------------------------------------
-   30 CONTINUE
-      CALL ZASYI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, RL, TOL, ELIM,
-     * ALIM)
-      IF (NW.LT.0) GO TO 130
-      GO TO 120
-   40 CONTINUE
-      IF (DFNU.LE.1.0D0) GO TO 70
-   50 CONTINUE
-C-----------------------------------------------------------------------
-C     OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM
-C-----------------------------------------------------------------------
-      CALL ZUOIK(ZR, ZI, FNU, KODE, 1, NN, CYR, CYI, NW, TOL, ELIM,
-     * ALIM)
-      IF (NW.LT.0) GO TO 130
-      NZ = NZ + NW
-      NN = NN - NW
-      IF (NN.EQ.0) RETURN
-      DFNU = FNU+DBLE(FLOAT(NN-1))
-      IF (DFNU.GT.FNUL) GO TO 110
-      IF (AZ.GT.FNUL) GO TO 110
-   60 CONTINUE
-      IF (AZ.GT.RL) GO TO 80
-   70 CONTINUE
-C-----------------------------------------------------------------------
-C     MILLER ALGORITHM NORMALIZED BY THE SERIES
-C-----------------------------------------------------------------------
-      CALL ZMLRI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL)
-      IF(NW.LT.0) GO TO 130
-      GO TO 120
-   80 CONTINUE
-C-----------------------------------------------------------------------
-C     MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN
-C-----------------------------------------------------------------------
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN
-C-----------------------------------------------------------------------
-      CALL ZUOIK(ZR, ZI, FNU, KODE, 2, 2, CWR, CWI, NW, TOL, ELIM,
-     * ALIM)
-      IF (NW.GE.0) GO TO 100
-      NZ = NN
-      DO 90 I=1,NN
-        CYR(I) = ZEROR
-        CYI(I) = ZEROI
-   90 CONTINUE
-      RETURN
-  100 CONTINUE
-      IF (NW.GT.0) GO TO 130
-      CALL ZWRSK(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, CWR, CWI, TOL,
-     * ELIM, ALIM)
-      IF (NW.LT.0) GO TO 130
-      GO TO 120
-  110 CONTINUE
-C-----------------------------------------------------------------------
-C     INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD
-C-----------------------------------------------------------------------
-      NUI = INT(SNGL(FNUL-DFNU)) + 1
-      NUI = MAX0(NUI,0)
-      CALL ZBUNI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, NUI, NLAST, FNUL,
-     * TOL, ELIM, ALIM)
-      IF (NW.LT.0) GO TO 130
-      NZ = NZ + NW
-      IF (NLAST.EQ.0) GO TO 120
-      NN = NLAST
-      GO TO 60
-  120 CONTINUE
-      RETURN
-  130 CONTINUE
-      NZ = -1
-      IF(NW.EQ.(-2)) NZ=-2
-      RETURN
-      END

amos/zbiry.f

@@ -1,364 +0,0 @@
-      SUBROUTINE ZBIRY(ZR, ZI, ID, KODE, BIR, BII, IERR)
-C***BEGIN PROLOGUE  ZBIRY
-C***DATE WRITTEN   830501   (YYMMDD)
-C***REVISION DATE  890801   (YYMMDD)
-C***CATEGORY NO.  B5K
-C***KEYWORDS  AIRY FUNCTION,BESSEL FUNCTIONS OF ORDER ONE THIRD
-C***AUTHOR  AMOS, DONALD E., SANDIA NATIONAL LABORATORIES
-C***PURPOSE  TO COMPUTE AIRY FUNCTIONS BI(Z) AND DBI(Z) FOR COMPLEX Z
-C***DESCRIPTION
-C
-C                      ***A DOUBLE PRECISION ROUTINE***
-C         ON KODE=1, CBIRY COMPUTES THE COMPLEX AIRY FUNCTION BI(Z) OR
-C         ITS DERIVATIVE DBI(Z)/DZ ON ID=0 OR ID=1 RESPECTIVELY. ON
-C         KODE=2, A SCALING OPTION CEXP(-AXZTA)*BI(Z) OR CEXP(-AXZTA)*
-C         DBI(Z)/DZ IS PROVIDED TO REMOVE THE EXPONENTIAL BEHAVIOR IN
-C         BOTH THE LEFT AND RIGHT HALF PLANES WHERE
-C         ZTA=(2/3)*Z*CSQRT(Z)=CMPLX(XZTA,YZTA) AND AXZTA=ABS(XZTA).
-C         DEFINTIONS AND NOTATION ARE FOUND IN THE NBS HANDBOOK OF
-C         MATHEMATICAL FUNCTIONS (REF. 1).
-C
-C         INPUT      ZR,ZI ARE DOUBLE PRECISION
-C           ZR,ZI  - Z=CMPLX(ZR,ZI)
-C           ID     - ORDER OF DERIVATIVE, ID=0 OR ID=1
-C           KODE   - A PARAMETER TO INDICATE THE SCALING OPTION
-C                    KODE= 1  RETURNS
-C                             BI=BI(Z)                 ON ID=0 OR
-C                             BI=DBI(Z)/DZ             ON ID=1
-C                        = 2  RETURNS
-C                             BI=CEXP(-AXZTA)*BI(Z)     ON ID=0 OR
-C                             BI=CEXP(-AXZTA)*DBI(Z)/DZ ON ID=1 WHERE
-C                             ZTA=(2/3)*Z*CSQRT(Z)=CMPLX(XZTA,YZTA)
-C                             AND AXZTA=ABS(XZTA)
-C
-C         OUTPUT     BIR,BII ARE DOUBLE PRECISION
-C           BIR,BII- COMPLEX ANSWER DEPENDING ON THE CHOICES FOR ID AND
-C                    KODE
-C           IERR   - ERROR FLAG
-C                    IERR=0, NORMAL RETURN - COMPUTATION COMPLETED
-C                    IERR=1, INPUT ERROR   - NO COMPUTATION
-C                    IERR=2, OVERFLOW      - NO COMPUTATION, REAL(Z)
-C                            TOO LARGE ON KODE=1
-C                    IERR=3, CABS(Z) LARGE      - COMPUTATION COMPLETED
-C                            LOSSES OF SIGNIFCANCE BY ARGUMENT REDUCTION
-C                            PRODUCE LESS THAN HALF OF MACHINE ACCURACY
-C                    IERR=4, CABS(Z) TOO LARGE  - NO COMPUTATION
-C                            COMPLETE LOSS OF ACCURACY BY ARGUMENT
-C                            REDUCTION
-C                    IERR=5, ERROR              - NO COMPUTATION,
-C                            ALGORITHM TERMINATION CONDITION NOT MET
-C
-C***LONG DESCRIPTION
-C
-C         BI AND DBI ARE COMPUTED FOR CABS(Z).GT.1.0 FROM THE I BESSEL
-C         FUNCTIONS BY
-C
-C                BI(Z)=C*SQRT(Z)*( I(-1/3,ZTA) + I(1/3,ZTA) )
-C               DBI(Z)=C *  Z  * ( I(-2/3,ZTA) + I(2/3,ZTA) )
-C                               C=1.0/SQRT(3.0)
-C                             ZTA=(2/3)*Z**(3/2)
-C
-C         WITH THE POWER SERIES FOR CABS(Z).LE.1.0.
-C
-C         IN MOST COMPLEX VARIABLE COMPUTATION, ONE MUST EVALUATE ELE-
-C         MENTARY FUNCTIONS. WHEN THE MAGNITUDE OF Z IS LARGE, LOSSES
-C         OF SIGNIFICANCE BY ARGUMENT REDUCTION OCCUR. CONSEQUENTLY, IF
-C         THE MAGNITUDE OF ZETA=(2/3)*Z**1.5 EXCEEDS U1=SQRT(0.5/UR),
-C         THEN LOSSES EXCEEDING HALF PRECISION ARE LIKELY AND AN ERROR
-C         FLAG IERR=3 IS TRIGGERED WHERE UR=DMAX1(D1MACH(4),1.0D-18) IS
-C         DOUBLE PRECISION UNIT ROUNDOFF LIMITED TO 18 DIGITS PRECISION.
-C         ALSO, IF THE MAGNITUDE OF ZETA IS LARGER THAN U2=0.5/UR, THEN
-C         ALL SIGNIFICANCE IS LOST AND IERR=4. IN ORDER TO USE THE INT
-C         FUNCTION, ZETA MUST BE FURTHER RESTRICTED NOT TO EXCEED THE
-C         LARGEST INTEGER, U3=I1MACH(9). THUS, THE MAGNITUDE OF ZETA
-C         MUST BE RESTRICTED BY MIN(U2,U3). ON 32 BIT MACHINES, U1,U2,
-C         AND U3 ARE APPROXIMATELY 2.0E+3, 4.2E+6, 2.1E+9 IN SINGLE
-C         PRECISION ARITHMETIC AND 1.3E+8, 1.8E+16, 2.1E+9 IN DOUBLE
-C         PRECISION ARITHMETIC RESPECTIVELY. THIS MAKES U2 AND U3 LIMIT-
-C         ING IN THEIR RESPECTIVE ARITHMETICS. THIS MEANS THAT THE MAG-
-C         NITUDE OF Z CANNOT EXCEED 3.1E+4 IN SINGLE AND 2.1E+6 IN
-C         DOUBLE PRECISION ARITHMETIC. THIS ALSO MEANS THAT ONE CAN
-C         EXPECT TO RETAIN, IN THE WORST CASES ON 32 BIT MACHINES,
-C         NO DIGITS IN SINGLE PRECISION AND ONLY 7 DIGITS IN DOUBLE
-C         PRECISION ARITHMETIC. SIMILAR CONSIDERATIONS HOLD FOR OTHER
-C         MACHINES.
-C
-C         THE APPROXIMATE RELATIVE ERROR IN THE MAGNITUDE OF A COMPLEX
-C         BESSEL FUNCTION CAN BE EXPRESSED BY P*10**S WHERE P=MAX(UNIT
-C         ROUNDOFF,1.0E-18) IS THE NOMINAL PRECISION AND 10**S REPRE-
-C         SENTS THE INCREASE IN ERROR DUE TO ARGUMENT REDUCTION IN THE
-C         ELEMENTARY FUNCTIONS. HERE, S=MAX(1,ABS(LOG10(CABS(Z))),
-C         ABS(LOG10(FNU))) APPROXIMATELY (I.E. S=MAX(1,ABS(EXPONENT OF
-C         CABS(Z),ABS(EXPONENT OF FNU)) ). HOWEVER, THE PHASE ANGLE MAY
-C         HAVE ONLY ABSOLUTE ACCURACY. THIS IS MOST LIKELY TO OCCUR WHEN
-C         ONE COMPONENT (IN ABSOLUTE VALUE) IS LARGER THAN THE OTHER BY
-C         SEVERAL ORDERS OF MAGNITUDE. IF ONE COMPONENT IS 10**K LARGER
-C         THAN THE OTHER, THEN ONE CAN EXPECT ONLY MAX(ABS(LOG10(P))-K,
-C         0) SIGNIFICANT DIGITS; OR, STATED ANOTHER WAY, WHEN K EXCEEDS
-C         THE EXPONENT OF P, NO SIGNIFICANT DIGITS REMAIN IN THE SMALLER
-C         COMPONENT. HOWEVER, THE PHASE ANGLE RETAINS ABSOLUTE ACCURACY
-C         BECAUSE, IN COMPLEX ARITHMETIC WITH PRECISION P, THE SMALLER
-C         COMPONENT WILL NOT (AS A RULE) DECREASE BELOW P TIMES THE
-C         MAGNITUDE OF THE LARGER COMPONENT. IN THESE EXTREME CASES,
-C         THE PRINCIPAL PHASE ANGLE IS ON THE ORDER OF +P, -P, PI/2-P,
-C         OR -PI/2+P.
-C
-C***REFERENCES  HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ
-C                 AND I. A. STEGUN, NBS AMS SERIES 55, U.S. DEPT. OF
-C                 COMMERCE, 1955.
-C
-C               COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT
-C                 AND LARGE ORDER BY D. E. AMOS, SAND83-0643, MAY, 1983
-C
-C               A SUBROUTINE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, SAND85-
-C                 1018, MAY, 1985
-C
-C               A PORTABLE PACKAGE FOR BESSEL FUNCTIONS OF A COMPLEX
-C                 ARGUMENT AND NONNEGATIVE ORDER BY D. E. AMOS, TRANS.
-C                 MATH. SOFTWARE, 1986
-C
-C***ROUTINES CALLED  ZBINU,ZABS,ZDIV,ZSQRT,D1MACH,I1MACH
-C***END PROLOGUE  ZBIRY
-C     COMPLEX BI,CONE,CSQ,CY,S1,S2,TRM1,TRM2,Z,ZTA,Z3
-      DOUBLE PRECISION AA, AD, AK, ALIM, ATRM, AZ, AZ3, BB, BII, BIR,
-     * BK, CC, CK, COEF, CONEI, CONER, CSQI, CSQR, CYI, CYR, C1, C2,
-     * DIG, DK, D1, D2, EAA, ELIM, FID, FMR, FNU, FNUL, PI, RL, R1M5,
-     * SFAC, STI, STR, S1I, S1R, S2I, S2R, TOL, TRM1I, TRM1R, TRM2I,
-     * TRM2R, TTH, ZI, ZR, ZTAI, ZTAR, Z3I, Z3R, D1MACH, ZABS
-      INTEGER ID, IERR, K, KODE, K1, K2, NZ, I1MACH
-      DIMENSION CYR(2), CYI(2)
-      DATA TTH, C1, C2, COEF, PI /6.66666666666666667D-01,
-     * 6.14926627446000736D-01,4.48288357353826359D-01,
-     * 5.77350269189625765D-01,3.14159265358979324D+00/
-      DATA CONER, CONEI /1.0D0,0.0D0/
-C***FIRST EXECUTABLE STATEMENT  ZBIRY
-      IERR = 0
-      NZ=0
-      IF (ID.LT.0 .OR. ID.GT.1) IERR=1
-      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
-      IF (IERR.NE.0) RETURN
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      TOL = DMAX1(D1MACH(4),1.0D-18)
-      FID = DBLE(FLOAT(ID))
-      IF (AZ.GT.1.0E0) GO TO 70
-C-----------------------------------------------------------------------
-C     POWER SERIES FOR CABS(Z).LE.1.
-C-----------------------------------------------------------------------
-      S1R = CONER
-      S1I = CONEI
-      S2R = CONER
-      S2I = CONEI
-      IF (AZ.LT.TOL) GO TO 130
-      AA = AZ*AZ
-      IF (AA.LT.TOL/AZ) GO TO 40
-      TRM1R = CONER
-      TRM1I = CONEI
-      TRM2R = CONER
-      TRM2I = CONEI
-      ATRM = 1.0D0
-      STR = ZR*ZR - ZI*ZI
-      STI = ZR*ZI + ZI*ZR
-      Z3R = STR*ZR - STI*ZI
-      Z3I = STR*ZI + STI*ZR
-      AZ3 = AZ*AA
-      AK = 2.0D0 + FID
-      BK = 3.0D0 - FID - FID
-      CK = 4.0D0 - FID
-      DK = 3.0D0 + FID + FID
-      D1 = AK*DK
-      D2 = BK*CK
-      AD = DMIN1(D1,D2)
-      AK = 24.0D0 + 9.0D0*FID
-      BK = 30.0D0 - 9.0D0*FID
-      DO 30 K=1,25
-        STR = (TRM1R*Z3R-TRM1I*Z3I)/D1
-        TRM1I = (TRM1R*Z3I+TRM1I*Z3R)/D1
-        TRM1R = STR
-        S1R = S1R + TRM1R
-        S1I = S1I + TRM1I
-        STR = (TRM2R*Z3R-TRM2I*Z3I)/D2
-        TRM2I = (TRM2R*Z3I+TRM2I*Z3R)/D2
-        TRM2R = STR
-        S2R = S2R + TRM2R
-        S2I = S2I + TRM2I
-        ATRM = ATRM*AZ3/AD
-        D1 = D1 + AK
-        D2 = D2 + BK
-        AD = DMIN1(D1,D2)
-        IF (ATRM.LT.TOL*AD) GO TO 40
-        AK = AK + 18.0D0
-        BK = BK + 18.0D0
-   30 CONTINUE
-   40 CONTINUE
-      IF (ID.EQ.1) GO TO 50
-      BIR = C1*S1R + C2*(ZR*S2R-ZI*S2I)
-      BII = C1*S1I + C2*(ZR*S2I+ZI*S2R)
-      IF (KODE.EQ.1) RETURN
-      CALL ZSQRT(ZR, ZI, STR, STI)
-      ZTAR = TTH*(ZR*STR-ZI*STI)
-      ZTAI = TTH*(ZR*STI+ZI*STR)
-      AA = ZTAR
-      AA = -DABS(AA)
-      EAA = DEXP(AA)
-      BIR = BIR*EAA
-      BII = BII*EAA
-      RETURN
-   50 CONTINUE
-      BIR = S2R*C2
-      BII = S2I*C2
-      IF (AZ.LE.TOL) GO TO 60
-      CC = C1/(1.0D0+FID)
-      STR = S1R*ZR - S1I*ZI
-      STI = S1R*ZI + S1I*ZR
-      BIR = BIR + CC*(STR*ZR-STI*ZI)
-      BII = BII + CC*(STR*ZI+STI*ZR)
-   60 CONTINUE
-      IF (KODE.EQ.1) RETURN
-      CALL ZSQRT(ZR, ZI, STR, STI)
-      ZTAR = TTH*(ZR*STR-ZI*STI)
-      ZTAI = TTH*(ZR*STI+ZI*STR)
-      AA = ZTAR
-      AA = -DABS(AA)
-      EAA = DEXP(AA)
-      BIR = BIR*EAA
-      BII = BII*EAA
-      RETURN
-C-----------------------------------------------------------------------
-C     CASE FOR CABS(Z).GT.1.0
-C-----------------------------------------------------------------------
-   70 CONTINUE
-      FNU = (1.0D0+FID)/3.0D0
-C-----------------------------------------------------------------------
-C     SET PARAMETERS RELATED TO MACHINE CONSTANTS.
-C     TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18.
-C     ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
-C     EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL    AND
-C     EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL       ARE INTERVALS NEAR
-C     UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
-C     RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
-C     DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
-C     FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU.
-C-----------------------------------------------------------------------
-      K1 = I1MACH(15)
-      K2 = I1MACH(16)
-      R1M5 = D1MACH(5)
-      K = MIN0(IABS(K1),IABS(K2))
-      ELIM = 2.303D0*(DBLE(FLOAT(K))*R1M5-3.0D0)
-      K1 = I1MACH(14) - 1
-      AA = R1M5*DBLE(FLOAT(K1))
-      DIG = DMIN1(AA,18.0D0)
-      AA = AA*2.303D0
-      ALIM = ELIM + DMAX1(-AA,-41.45D0)
-      RL = 1.2D0*DIG + 3.0D0
-      FNUL = 10.0D0 + 6.0D0*(DIG-3.0D0)
-C-----------------------------------------------------------------------
-C     TEST FOR RANGE
-C-----------------------------------------------------------------------
-      AA=0.5D0/TOL
-      BB=DBLE(FLOAT(I1MACH(9)))*0.5D0
-      AA=DMIN1(AA,BB)
-      AA=AA**TTH
-      IF (AZ.GT.AA) GO TO 260
-      AA=DSQRT(AA)
-      IF (AZ.GT.AA) IERR=3
-      CALL ZSQRT(ZR, ZI, CSQR, CSQI)
-      ZTAR = TTH*(ZR*CSQR-ZI*CSQI)
-      ZTAI = TTH*(ZR*CSQI+ZI*CSQR)
-C-----------------------------------------------------------------------
-C     RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL
-C-----------------------------------------------------------------------
-      SFAC = 1.0D0
-      AK = ZTAI
-      IF (ZR.GE.0.0D0) GO TO 80
-      BK = ZTAR
-      CK = -DABS(BK)
-      ZTAR = CK
-      ZTAI = AK
-   80 CONTINUE
-      IF (ZI.NE.0.0D0 .OR. ZR.GT.0.0D0) GO TO 90
-      ZTAR = 0.0D0
-      ZTAI = AK
-   90 CONTINUE
-      AA = ZTAR
-      IF (KODE.EQ.2) GO TO 100
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST
-C-----------------------------------------------------------------------
-      BB = DABS(AA)
-      IF (BB.LT.ALIM) GO TO 100
-      BB = BB + 0.25D0*DLOG(AZ)
-      SFAC = TOL
-      IF (BB.GT.ELIM) GO TO 190
-  100 CONTINUE
-      FMR = 0.0D0
-      IF (AA.GE.0.0D0 .AND. ZR.GT.0.0D0) GO TO 110
-      FMR = PI
-      IF (ZI.LT.0.0D0) FMR = -PI
-      ZTAR = -ZTAR
-      ZTAI = -ZTAI
-  110 CONTINUE
-C-----------------------------------------------------------------------
-C     AA=FACTOR FOR ANALYTIC CONTINUATION OF I(FNU,ZTA)
-C     KODE=2 RETURNS EXP(-ABS(XZTA))*I(FNU,ZTA) FROM CBESI
-C-----------------------------------------------------------------------
-      CALL ZBINU(ZTAR, ZTAI, FNU, KODE, 1, CYR, CYI, NZ, RL, FNUL, TOL,
-     * ELIM, ALIM)
-      IF (NZ.LT.0) GO TO 200
-      AA = FMR*FNU
-      Z3R = SFAC
-      STR = DCOS(AA)
-      STI = DSIN(AA)
-      S1R = (STR*CYR(1)-STI*CYI(1))*Z3R
-      S1I = (STR*CYI(1)+STI*CYR(1))*Z3R
-      FNU = (2.0D0-FID)/3.0D0
-      CALL ZBINU(ZTAR, ZTAI, FNU, KODE, 2, CYR, CYI, NZ, RL, FNUL, TOL,
-     * ELIM, ALIM)
-      CYR(1) = CYR(1)*Z3R
-      CYI(1) = CYI(1)*Z3R
-      CYR(2) = CYR(2)*Z3R
-      CYI(2) = CYI(2)*Z3R
-C-----------------------------------------------------------------------
-C     BACKWARD RECUR ONE STEP FOR ORDERS -1/3 OR -2/3
-C-----------------------------------------------------------------------
-      CALL ZDIV(CYR(1), CYI(1), ZTAR, ZTAI, STR, STI)
-      S2R = (FNU+FNU)*STR + CYR(2)
-      S2I = (FNU+FNU)*STI + CYI(2)
-      AA = FMR*(FNU-1.0D0)
-      STR = DCOS(AA)
-      STI = DSIN(AA)
-      S1R = COEF*(S1R+S2R*STR-S2I*STI)
-      S1I = COEF*(S1I+S2R*STI+S2I*STR)
-      IF (ID.EQ.1) GO TO 120
-      STR = CSQR*S1R - CSQI*S1I
-      S1I = CSQR*S1I + CSQI*S1R
-      S1R = STR
-      BIR = S1R/SFAC
-      BII = S1I/SFAC
-      RETURN
-  120 CONTINUE
-      STR = ZR*S1R - ZI*S1I
-      S1I = ZR*S1I + ZI*S1R
-      S1R = STR
-      BIR = S1R/SFAC
-      BII = S1I/SFAC
-      RETURN
-  130 CONTINUE
-      AA = C1*(1.0D0-FID) + FID*C2
-      BIR = AA
-      BII = 0.0D0
-      RETURN
-  190 CONTINUE
-      IERR=2
-      NZ=0
-      RETURN
-  200 CONTINUE
-      IF(NZ.EQ.(-1)) GO TO 190
-      NZ=0
-      IERR=5
-      RETURN
-  260 CONTINUE
-      IERR=4
-      NZ=0
-      RETURN
-      END

amos/zbknu.f

@@ -1,568 +0,0 @@
-      SUBROUTINE ZBKNU(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM,
-     * ALIM)
-C***BEGIN PROLOGUE  ZBKNU
-C***REFER TO  ZBESI,ZBESK,ZAIRY,ZBESH
-C
-C     ZBKNU COMPUTES THE K BESSEL FUNCTION IN THE RIGHT HALF Z PLANE.
-C
-C***ROUTINES CALLED  DGAMLN,I1MACH,D1MACH,ZKSCL,ZSHCH,ZUCHK,ZABS,ZDIV,
-C                    ZEXP,ZLOG,ZMLT,ZSQRT
-C***END PROLOGUE  ZBKNU
-C
-      DOUBLE PRECISION AA, AK, ALIM, ASCLE, A1, A2, BB, BK, BRY, CAZ,
-     * CBI, CBR, CC, CCHI, CCHR, CKI, CKR, COEFI, COEFR, CONEI, CONER,
-     * CRSCR, CSCLR, CSHI, CSHR, CSI, CSR, CSRR, CSSR, CTWOR,
-     * CZEROI, CZEROR, CZI, CZR, DNU, DNU2, DPI, ELIM, ETEST, FC, FHS,
-     * FI, FK, FKS, FMUI, FMUR, FNU, FPI, FR, G1, G2, HPI, PI, PR, PTI,
-     * PTR, P1I, P1R, P2I, P2M, P2R, QI, QR, RAK, RCAZ, RTHPI, RZI,
-     * RZR, R1, S, SMUI, SMUR, SPI, STI, STR, S1I, S1R, S2I, S2R, TM,
-     * TOL, TTH, T1, T2, YI, YR, ZI, ZR, DGAMLN, D1MACH, ZABS, ELM,
-     * CELMR, ZDR, ZDI, AS, ALAS, HELIM, CYR, CYI
-      INTEGER I, IFLAG, INU, K, KFLAG, KK, KMAX, KODE, KODED, N, NZ,
-     * IDUM, I1MACH, J, IC, INUB, NW
-      DIMENSION YR(N), YI(N), CC(8), CSSR(3), CSRR(3), BRY(3), CYR(2),
-     * CYI(2)
-C     COMPLEX Z,Y,A,B,RZ,SMU,FU,FMU,F,FLRZ,CZ,S1,S2,CSH,CCH
-C     COMPLEX CK,P,Q,COEF,P1,P2,CBK,PT,CZERO,CONE,CTWO,ST,EZ,CS,DK
-C
-      DATA KMAX / 30 /
-      DATA CZEROR,CZEROI,CONER,CONEI,CTWOR,R1/
-     1  0.0D0 , 0.0D0 , 1.0D0 , 0.0D0 , 2.0D0 , 2.0D0 /
-      DATA DPI, RTHPI, SPI ,HPI, FPI, TTH /
-     1     3.14159265358979324D0,       1.25331413731550025D0,
-     2     1.90985931710274403D0,       1.57079632679489662D0,
-     3     1.89769999331517738D0,       6.66666666666666666D-01/
-      DATA CC(1), CC(2), CC(3), CC(4), CC(5), CC(6), CC(7), CC(8)/
-     1     5.77215664901532861D-01,    -4.20026350340952355D-02,
-     2    -4.21977345555443367D-02,     7.21894324666309954D-03,
-     3    -2.15241674114950973D-04,    -2.01348547807882387D-05,
-     4     1.13302723198169588D-06,     6.11609510448141582D-09/
-C
-      CAZ = ZABS(COMPLEX(ZR,ZI))
-      CSCLR = 1.0D0/TOL
-      CRSCR = TOL
-      CSSR(1) = CSCLR
-      CSSR(2) = 1.0D0
-      CSSR(3) = CRSCR
-      CSRR(1) = CRSCR
-      CSRR(2) = 1.0D0
-      CSRR(3) = CSCLR
-      BRY(1) = 1.0D+3*D1MACH(1)/TOL
-      BRY(2) = 1.0D0/BRY(1)
-      BRY(3) = D1MACH(2)
-      NZ = 0
-      IFLAG = 0
-      KODED = KODE
-      RCAZ = 1.0D0/CAZ
-      STR = ZR*RCAZ
-      STI = -ZI*RCAZ
-      RZR = (STR+STR)*RCAZ
-      RZI = (STI+STI)*RCAZ
-      INU = INT(SNGL(FNU+0.5D0))
-      DNU = FNU - DBLE(FLOAT(INU))
-      IF (DABS(DNU).EQ.0.5D0) GO TO 110
-      DNU2 = 0.0D0
-      IF (DABS(DNU).GT.TOL) DNU2 = DNU*DNU
-      IF (CAZ.GT.R1) GO TO 110
-C-----------------------------------------------------------------------
-C     SERIES FOR CABS(Z).LE.R1
-C-----------------------------------------------------------------------
-      FC = 1.0D0
-      CALL ZLOG(RZR, RZI, SMUR, SMUI, IDUM)
-      FMUR = SMUR*DNU
-      FMUI = SMUI*DNU
-      CALL ZSHCH(FMUR, FMUI, CSHR, CSHI, CCHR, CCHI)
-      IF (DNU.EQ.0.0D0) GO TO 10
-      FC = DNU*DPI
-      FC = FC/DSIN(FC)
-      SMUR = CSHR/DNU
-      SMUI = CSHI/DNU
-   10 CONTINUE
-      A2 = 1.0D0 + DNU
-C-----------------------------------------------------------------------
-C     GAM(1-Z)*GAM(1+Z)=PI*Z/SIN(PI*Z), T1=1/GAM(1-DNU), T2=1/GAM(1+DNU)
-C-----------------------------------------------------------------------
-      T2 = DEXP(-DGAMLN(A2,IDUM))
-      T1 = 1.0D0/(T2*FC)
-      IF (DABS(DNU).GT.0.1D0) GO TO 40
-C-----------------------------------------------------------------------
-C     SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU)
-C-----------------------------------------------------------------------
-      AK = 1.0D0
-      S = CC(1)
-      DO 20 K=2,8
-        AK = AK*DNU2
-        TM = CC(K)*AK
-        S = S + TM
-        IF (DABS(TM).LT.TOL) GO TO 30
-   20 CONTINUE
-   30 G1 = -S
-      GO TO 50
-   40 CONTINUE
-      G1 = (T1-T2)/(DNU+DNU)
-   50 CONTINUE
-      G2 = (T1+T2)*0.5D0
-      FR = FC*(CCHR*G1+SMUR*G2)
-      FI = FC*(CCHI*G1+SMUI*G2)
-      CALL ZEXP(FMUR, FMUI, STR, STI)
-      PR = 0.5D0*STR/T2
-      PI = 0.5D0*STI/T2
-      CALL ZDIV(0.5D0, 0.0D0, STR, STI, PTR, PTI)
-      QR = PTR/T1
-      QI = PTI/T1
-      S1R = FR
-      S1I = FI
-      S2R = PR
-      S2I = PI
-      AK = 1.0D0
-      A1 = 1.0D0
-      CKR = CONER
-      CKI = CONEI
-      BK = 1.0D0 - DNU2
-      IF (INU.GT.0 .OR. N.GT.1) GO TO 80
-C-----------------------------------------------------------------------
-C     GENERATE K(FNU,Z), 0.0D0 .LE. FNU .LT. 0.5D0 AND N=1
-C-----------------------------------------------------------------------
-      IF (CAZ.LT.TOL) GO TO 70
-      CALL ZMLT(ZR, ZI, ZR, ZI, CZR, CZI)
-      CZR = 0.25D0*CZR
-      CZI = 0.25D0*CZI
-      T1 = 0.25D0*CAZ*CAZ
-   60 CONTINUE
-      FR = (FR*AK+PR+QR)/BK
-      FI = (FI*AK+PI+QI)/BK
-      STR = 1.0D0/(AK-DNU)
-      PR = PR*STR
-      PI = PI*STR
-      STR = 1.0D0/(AK+DNU)
-      QR = QR*STR
-      QI = QI*STR
-      STR = CKR*CZR - CKI*CZI
-      RAK = 1.0D0/AK
-      CKI = (CKR*CZI+CKI*CZR)*RAK
-      CKR = STR*RAK
-      S1R = CKR*FR - CKI*FI + S1R
-      S1I = CKR*FI + CKI*FR + S1I
-      A1 = A1*T1*RAK
-      BK = BK + AK + AK + 1.0D0
-      AK = AK + 1.0D0
-      IF (A1.GT.TOL) GO TO 60
-   70 CONTINUE
-      YR(1) = S1R
-      YI(1) = S1I
-      IF (KODED.EQ.1) RETURN
-      CALL ZEXP(ZR, ZI, STR, STI)
-      CALL ZMLT(S1R, S1I, STR, STI, YR(1), YI(1))
-      RETURN
-C-----------------------------------------------------------------------
-C     GENERATE K(DNU,Z) AND K(DNU+1,Z) FOR FORWARD RECURRENCE
-C-----------------------------------------------------------------------
-   80 CONTINUE
-      IF (CAZ.LT.TOL) GO TO 100
-      CALL ZMLT(ZR, ZI, ZR, ZI, CZR, CZI)
-      CZR = 0.25D0*CZR
-      CZI = 0.25D0*CZI
-      T1 = 0.25D0*CAZ*CAZ
-   90 CONTINUE
-      FR = (FR*AK+PR+QR)/BK
-      FI = (FI*AK+PI+QI)/BK
-      STR = 1.0D0/(AK-DNU)
-      PR = PR*STR
-      PI = PI*STR
-      STR = 1.0D0/(AK+DNU)
-      QR = QR*STR
-      QI = QI*STR
-      STR = CKR*CZR - CKI*CZI
-      RAK = 1.0D0/AK
-      CKI = (CKR*CZI+CKI*CZR)*RAK
-      CKR = STR*RAK
-      S1R = CKR*FR - CKI*FI + S1R
-      S1I = CKR*FI + CKI*FR + S1I
-      STR = PR - FR*AK
-      STI = PI - FI*AK
-      S2R = CKR*STR - CKI*STI + S2R
-      S2I = CKR*STI + CKI*STR + S2I
-      A1 = A1*T1*RAK
-      BK = BK + AK + AK + 1.0D0
-      AK = AK + 1.0D0
-      IF (A1.GT.TOL) GO TO 90
-  100 CONTINUE
-      KFLAG = 2
-      A1 = FNU + 1.0D0
-      AK = A1*DABS(SMUR)
-      IF (AK.GT.ALIM) KFLAG = 3
-      STR = CSSR(KFLAG)
-      P2R = S2R*STR
-      P2I = S2I*STR
-      CALL ZMLT(P2R, P2I, RZR, RZI, S2R, S2I)
-      S1R = S1R*STR
-      S1I = S1I*STR
-      IF (KODED.EQ.1) GO TO 210
-      CALL ZEXP(ZR, ZI, FR, FI)
-      CALL ZMLT(S1R, S1I, FR, FI, S1R, S1I)
-      CALL ZMLT(S2R, S2I, FR, FI, S2R, S2I)
-      GO TO 210
-C-----------------------------------------------------------------------
-C     IFLAG=0 MEANS NO UNDERFLOW OCCURRED
-C     IFLAG=1 MEANS AN UNDERFLOW OCCURRED- COMPUTATION PROCEEDS WITH
-C     KODED=2 AND A TEST FOR ON SCALE VALUES IS MADE DURING FORWARD
-C     RECURSION
-C-----------------------------------------------------------------------
-  110 CONTINUE
-      CALL ZSQRT(ZR, ZI, STR, STI)
-      CALL ZDIV(RTHPI, CZEROI, STR, STI, COEFR, COEFI)
-      KFLAG = 2
-      IF (KODED.EQ.2) GO TO 120
-      IF (ZR.GT.ALIM) GO TO 290
-C     BLANK LINE
-      STR = DEXP(-ZR)*CSSR(KFLAG)
-      STI = -STR*DSIN(ZI)
-      STR = STR*DCOS(ZI)
-      CALL ZMLT(COEFR, COEFI, STR, STI, COEFR, COEFI)
-  120 CONTINUE
-      IF (DABS(DNU).EQ.0.5D0) GO TO 300
-C-----------------------------------------------------------------------
-C     MILLER ALGORITHM FOR CABS(Z).GT.R1
-C-----------------------------------------------------------------------
-      AK = DCOS(DPI*DNU)
-      AK = DABS(AK)
-      IF (AK.EQ.CZEROR) GO TO 300
-      FHS = DABS(0.25D0-DNU2)
-      IF (FHS.EQ.CZEROR) GO TO 300
-C-----------------------------------------------------------------------
-C     COMPUTE R2=F(E). IF CABS(Z).GE.R2, USE FORWARD RECURRENCE TO
-C     DETERMINE THE BACKWARD INDEX K. R2=F(E) IS A STRAIGHT LINE ON
-C     12.LE.E.LE.60. E IS COMPUTED FROM 2**(-E)=B**(1-I1MACH(14))=
-C     TOL WHERE B IS THE BASE OF THE ARITHMETIC.
-C-----------------------------------------------------------------------
-      T1 = DBLE(FLOAT(I1MACH(14)-1))
-      T1 = T1*D1MACH(5)*3.321928094D0
-      T1 = DMAX1(T1,12.0D0)
-      T1 = DMIN1(T1,60.0D0)
-      T2 = TTH*T1 - 6.0D0
-      IF (ZR.NE.0.0D0) GO TO 130
-      T1 = HPI
-      GO TO 140
-  130 CONTINUE
-      T1 = DATAN(ZI/ZR)
-      T1 = DABS(T1)
-  140 CONTINUE
-      IF (T2.GT.CAZ) GO TO 170
-C-----------------------------------------------------------------------
-C     FORWARD RECURRENCE LOOP WHEN CABS(Z).GE.R2
-C-----------------------------------------------------------------------
-      ETEST = AK/(DPI*CAZ*TOL)
-      FK = CONER
-      IF (ETEST.LT.CONER) GO TO 180
-      FKS = CTWOR
-      CKR = CAZ + CAZ + CTWOR
-      P1R = CZEROR
-      P2R = CONER
-      DO 150 I=1,KMAX
-        AK = FHS/FKS
-        CBR = CKR/(FK+CONER)
-        PTR = P2R
-        P2R = CBR*P2R - P1R*AK
-        P1R = PTR
-        CKR = CKR + CTWOR
-        FKS = FKS + FK + FK + CTWOR
-        FHS = FHS + FK + FK
-        FK = FK + CONER
-        STR = DABS(P2R)*FK
-        IF (ETEST.LT.STR) GO TO 160
-  150 CONTINUE
-      GO TO 310
-  160 CONTINUE
-      FK = FK + SPI*T1*DSQRT(T2/CAZ)
-      FHS = DABS(0.25D0-DNU2)
-      GO TO 180
-  170 CONTINUE
-C-----------------------------------------------------------------------
-C     COMPUTE BACKWARD INDEX K FOR CABS(Z).LT.R2
-C-----------------------------------------------------------------------
-      A2 = DSQRT(CAZ)
-      AK = FPI*AK/(TOL*DSQRT(A2))
-      AA = 3.0D0*T1/(1.0D0+CAZ)
-      BB = 14.7D0*T1/(28.0D0+CAZ)
-      AK = (DLOG(AK)+CAZ*DCOS(AA)/(1.0D0+0.008D0*CAZ))/DCOS(BB)
-      FK = 0.12125D0*AK*AK/CAZ + 1.5D0
-  180 CONTINUE
-C-----------------------------------------------------------------------
-C     BACKWARD RECURRENCE LOOP FOR MILLER ALGORITHM
-C-----------------------------------------------------------------------
-      K = INT(SNGL(FK))
-      FK = DBLE(FLOAT(K))
-      FKS = FK*FK
-      P1R = CZEROR
-      P1I = CZEROI
-      P2R = TOL
-      P2I = CZEROI
-      CSR = P2R
-      CSI = P2I
-      DO 190 I=1,K
-        A1 = FKS - FK
-        AK = (FKS+FK)/(A1+FHS)
-        RAK = 2.0D0/(FK+CONER)
-        CBR = (FK+ZR)*RAK
-        CBI = ZI*RAK
-        PTR = P2R
-        PTI = P2I
-        P2R = (PTR*CBR-PTI*CBI-P1R)*AK
-        P2I = (PTI*CBR+PTR*CBI-P1I)*AK
-        P1R = PTR
-        P1I = PTI
-        CSR = CSR + P2R
-        CSI = CSI + P2I
-        FKS = A1 - FK + CONER
-        FK = FK - CONER
-  190 CONTINUE
-C-----------------------------------------------------------------------
-C     COMPUTE (P2/CS)=(P2/CABS(CS))*(CONJG(CS)/CABS(CS)) FOR BETTER
-C     SCALING
-C-----------------------------------------------------------------------
-      TM = ZABS(COMPLEX(CSR,CSI))
-      PTR = 1.0D0/TM
-      S1R = P2R*PTR
-      S1I = P2I*PTR
-      CSR = CSR*PTR
-      CSI = -CSI*PTR
-      CALL ZMLT(COEFR, COEFI, S1R, S1I, STR, STI)
-      CALL ZMLT(STR, STI, CSR, CSI, S1R, S1I)
-      IF (INU.GT.0 .OR. N.GT.1) GO TO 200
-      ZDR = ZR
-      ZDI = ZI
-      IF(IFLAG.EQ.1) GO TO 270
-      GO TO 240
-  200 CONTINUE
-C-----------------------------------------------------------------------
-C     COMPUTE P1/P2=(P1/CABS(P2)*CONJG(P2)/CABS(P2) FOR SCALING
-C-----------------------------------------------------------------------
-      TM = ZABS(COMPLEX(P2R,P2I))
-      PTR = 1.0D0/TM
-      P1R = P1R*PTR
-      P1I = P1I*PTR
-      P2R = P2R*PTR
-      P2I = -P2I*PTR
-      CALL ZMLT(P1R, P1I, P2R, P2I, PTR, PTI)
-      STR = DNU + 0.5D0 - PTR
-      STI = -PTI
-      CALL ZDIV(STR, STI, ZR, ZI, STR, STI)
-      STR = STR + 1.0D0
-      CALL ZMLT(STR, STI, S1R, S1I, S2R, S2I)
-C-----------------------------------------------------------------------
-C     FORWARD RECURSION ON THE THREE TERM RECURSION WITH RELATION WITH
-C     SCALING NEAR EXPONENT EXTREMES ON KFLAG=1 OR KFLAG=3
-C-----------------------------------------------------------------------
-  210 CONTINUE
-      STR = DNU + 1.0D0
-      CKR = STR*RZR
-      CKI = STR*RZI
-      IF (N.EQ.1) INU = INU - 1
-      IF (INU.GT.0) GO TO 220
-      IF (N.GT.1) GO TO 215
-      S1R = S2R
-      S1I = S2I
-  215 CONTINUE
-      ZDR = ZR
-      ZDI = ZI
-      IF(IFLAG.EQ.1) GO TO 270
-      GO TO 240
-  220 CONTINUE
-      INUB = 1
-      IF(IFLAG.EQ.1) GO TO 261
-  225 CONTINUE
-      P1R = CSRR(KFLAG)
-      ASCLE = BRY(KFLAG)
-      DO 230 I=INUB,INU
-        STR = S2R
-        STI = S2I
-        S2R = CKR*STR - CKI*STI + S1R
-        S2I = CKR*STI + CKI*STR + S1I
-        S1R = STR
-        S1I = STI
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        IF (KFLAG.GE.3) GO TO 230
-        P2R = S2R*P1R
-        P2I = S2I*P1R
-        STR = DABS(P2R)
-        STI = DABS(P2I)
-        P2M = DMAX1(STR,STI)
-        IF (P2M.LE.ASCLE) GO TO 230
-        KFLAG = KFLAG + 1
-        ASCLE = BRY(KFLAG)
-        S1R = S1R*P1R
-        S1I = S1I*P1R
-        S2R = P2R
-        S2I = P2I
-        STR = CSSR(KFLAG)
-        S1R = S1R*STR
-        S1I = S1I*STR
-        S2R = S2R*STR
-        S2I = S2I*STR
-        P1R = CSRR(KFLAG)
-  230 CONTINUE
-      IF (N.NE.1) GO TO 240
-      S1R = S2R
-      S1I = S2I
-  240 CONTINUE
-      STR = CSRR(KFLAG)
-      YR(1) = S1R*STR
-      YI(1) = S1I*STR
-      IF (N.EQ.1) RETURN
-      YR(2) = S2R*STR
-      YI(2) = S2I*STR
-      IF (N.EQ.2) RETURN
-      KK = 2
-  250 CONTINUE
-      KK = KK + 1
-      IF (KK.GT.N) RETURN
-      P1R = CSRR(KFLAG)
-      ASCLE = BRY(KFLAG)
-      DO 260 I=KK,N
-        P2R = S2R
-        P2I = S2I
-        S2R = CKR*P2R - CKI*P2I + S1R
-        S2I = CKI*P2R + CKR*P2I + S1I
-        S1R = P2R
-        S1I = P2I
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        P2R = S2R*P1R
-        P2I = S2I*P1R
-        YR(I) = P2R
-        YI(I) = P2I
-        IF (KFLAG.GE.3) GO TO 260
-        STR = DABS(P2R)
-        STI = DABS(P2I)
-        P2M = DMAX1(STR,STI)
-        IF (P2M.LE.ASCLE) GO TO 260
-        KFLAG = KFLAG + 1
-        ASCLE = BRY(KFLAG)
-        S1R = S1R*P1R
-        S1I = S1I*P1R
-        S2R = P2R
-        S2I = P2I
-        STR = CSSR(KFLAG)
-        S1R = S1R*STR
-        S1I = S1I*STR
-        S2R = S2R*STR
-        S2I = S2I*STR
-        P1R = CSRR(KFLAG)
-  260 CONTINUE
-      RETURN
-C-----------------------------------------------------------------------
-C     IFLAG=1 CASES, FORWARD RECURRENCE ON SCALED VALUES ON UNDERFLOW
-C-----------------------------------------------------------------------
-  261 CONTINUE
-      HELIM = 0.5D0*ELIM
-      ELM = DEXP(-ELIM)
-      CELMR = ELM
-      ASCLE = BRY(1)
-      ZDR = ZR
-      ZDI = ZI
-      IC = -1
-      J = 2
-      DO 262 I=1,INU
-        STR = S2R
-        STI = S2I
-        S2R = STR*CKR-STI*CKI+S1R
-        S2I = STI*CKR+STR*CKI+S1I
-        S1R = STR
-        S1I = STI
-        CKR = CKR+RZR
-        CKI = CKI+RZI
-        AS = ZABS(COMPLEX(S2R,S2I))
-        ALAS = DLOG(AS)
-        P2R = -ZDR+ALAS
-        IF(P2R.LT.(-ELIM)) GO TO 263
-        CALL ZLOG(S2R,S2I,STR,STI,IDUM)
-        P2R = -ZDR+STR
-        P2I = -ZDI+STI
-        P2M = DEXP(P2R)/TOL
-        P1R = P2M*DCOS(P2I)
-        P1I = P2M*DSIN(P2I)
-        CALL ZUCHK(P1R,P1I,NW,ASCLE,TOL)
-        IF(NW.NE.0) GO TO 263
-        J = 3 - J
-        CYR(J) = P1R
-        CYI(J) = P1I
-        IF(IC.EQ.(I-1)) GO TO 264
-        IC = I
-        GO TO 262
-  263   CONTINUE
-        IF(ALAS.LT.HELIM) GO TO 262
-        ZDR = ZDR-ELIM
-        S1R = S1R*CELMR
-        S1I = S1I*CELMR
-        S2R = S2R*CELMR
-        S2I = S2I*CELMR
-  262 CONTINUE
-      IF(N.NE.1) GO TO 270
-      S1R = S2R
-      S1I = S2I
-      GO TO 270
-  264 CONTINUE
-      KFLAG = 1
-      INUB = I+1
-      S2R = CYR(J)
-      S2I = CYI(J)
-      J = 3 - J
-      S1R = CYR(J)
-      S1I = CYI(J)
-      IF(INUB.LE.INU) GO TO 225
-      IF(N.NE.1) GO TO 240
-      S1R = S2R
-      S1I = S2I
-      GO TO 240
-  270 CONTINUE
-      YR(1) = S1R
-      YI(1) = S1I
-      IF(N.EQ.1) GO TO 280
-      YR(2) = S2R
-      YI(2) = S2I
-  280 CONTINUE
-      ASCLE = BRY(1)
-      CALL ZKSCL(ZDR,ZDI,FNU,N,YR,YI,NZ,RZR,RZI,ASCLE,TOL,ELIM)
-      INU = N - NZ
-      IF (INU.LE.0) RETURN
-      KK = NZ + 1
-      S1R = YR(KK)
-      S1I = YI(KK)
-      YR(KK) = S1R*CSRR(1)
-      YI(KK) = S1I*CSRR(1)
-      IF (INU.EQ.1) RETURN
-      KK = NZ + 2
-      S2R = YR(KK)
-      S2I = YI(KK)
-      YR(KK) = S2R*CSRR(1)
-      YI(KK) = S2I*CSRR(1)
-      IF (INU.EQ.2) RETURN
-      T2 = FNU + DBLE(FLOAT(KK-1))
-      CKR = T2*RZR
-      CKI = T2*RZI
-      KFLAG = 1
-      GO TO 250
-  290 CONTINUE
-C-----------------------------------------------------------------------
-C     SCALE BY DEXP(Z), IFLAG = 1 CASES
-C-----------------------------------------------------------------------
-      KODED = 2
-      IFLAG = 1
-      KFLAG = 2
-      GO TO 120
-C-----------------------------------------------------------------------
-C     FNU=HALF ODD INTEGER CASE, DNU=-0.5
-C-----------------------------------------------------------------------
-  300 CONTINUE
-      S1R = COEFR
-      S1I = COEFI
-      S2R = COEFR
-      S2I = COEFI
-      GO TO 210
-C
-C
-  310 CONTINUE
-      NZ=-2
-      RETURN
-      END

amos/zbuni.f

@@ -1,174 +0,0 @@
-      SUBROUTINE ZBUNI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NUI, NLAST,
-     * FNUL, TOL, ELIM, ALIM)
-C***BEGIN PROLOGUE  ZBUNI
-C***REFER TO  ZBESI,ZBESK
-C
-C     ZBUNI COMPUTES THE I BESSEL FUNCTION FOR LARGE CABS(Z).GT.
-C     FNUL AND FNU+N-1.LT.FNUL. THE ORDER IS INCREASED FROM
-C     FNU+N-1 GREATER THAN FNUL BY ADDING NUI AND COMPUTING
-C     ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR I(FNU,Z)
-C     ON IFORM=1 AND THE EXPANSION FOR J(FNU,Z) ON IFORM=2
-C
-C***ROUTINES CALLED  ZUNI1,ZUNI2,ZABS,D1MACH
-C***END PROLOGUE  ZBUNI
-C     COMPLEX CSCL,CSCR,CY,RZ,ST,S1,S2,Y,Z
-      DOUBLE PRECISION ALIM, AX, AY, CSCLR, CSCRR, CYI, CYR, DFNU,
-     * ELIM, FNU, FNUI, FNUL, GNU, RAZ, RZI, RZR, STI, STR, S1I, S1R,
-     * S2I, S2R, TOL, YI, YR, ZI, ZR, ZABS, ASCLE, BRY, C1R, C1I, C1M,
-     * D1MACH
-      INTEGER I, IFLAG, IFORM, K, KODE, N, NL, NLAST, NUI, NW, NZ
-      DIMENSION YR(N), YI(N), CYR(2), CYI(2), BRY(3)
-      NZ = 0
-      AX = DABS(ZR)*1.7321D0
-      AY = DABS(ZI)
-      IFORM = 1
-      IF (AY.GT.AX) IFORM = 2
-      IF (NUI.EQ.0) GO TO 60
-      FNUI = DBLE(FLOAT(NUI))
-      DFNU = FNU + DBLE(FLOAT(N-1))
-      GNU = DFNU + FNUI
-      IF (IFORM.EQ.2) GO TO 10
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN
-C     -PI/3.LE.ARG(Z).LE.PI/3
-C-----------------------------------------------------------------------
-      CALL ZUNI1(ZR, ZI, GNU, KODE, 2, CYR, CYI, NW, NLAST, FNUL, TOL,
-     * ELIM, ALIM)
-      GO TO 20
-   10 CONTINUE
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU
-C     APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I
-C     AND HPI=PI/2
-C-----------------------------------------------------------------------
-      CALL ZUNI2(ZR, ZI, GNU, KODE, 2, CYR, CYI, NW, NLAST, FNUL, TOL,
-     * ELIM, ALIM)
-   20 CONTINUE
-      IF (NW.LT.0) GO TO 50
-      IF (NW.NE.0) GO TO 90
-      STR = ZABS(COMPLEX(CYR(1),CYI(1)))
-C----------------------------------------------------------------------
-C     SCALE BACKWARD RECURRENCE, BRY(3) IS DEFINED BUT NEVER USED
-C----------------------------------------------------------------------
-      BRY(1)=1.0D+3*D1MACH(1)/TOL
-      BRY(2) = 1.0D0/BRY(1)
-      BRY(3) = BRY(2)
-      IFLAG = 2
-      ASCLE = BRY(2)
-      CSCLR = 1.0D0
-      IF (STR.GT.BRY(1)) GO TO 21
-      IFLAG = 1
-      ASCLE = BRY(1)
-      CSCLR = 1.0D0/TOL
-      GO TO 25
-   21 CONTINUE
-      IF (STR.LT.BRY(2)) GO TO 25
-      IFLAG = 3
-      ASCLE=BRY(3)
-      CSCLR = TOL
-   25 CONTINUE
-      CSCRR = 1.0D0/CSCLR
-      S1R = CYR(2)*CSCLR
-      S1I = CYI(2)*CSCLR
-      S2R = CYR(1)*CSCLR
-      S2I = CYI(1)*CSCLR
-      RAZ = 1.0D0/ZABS(COMPLEX(ZR,ZI))
-      STR = ZR*RAZ
-      STI = -ZI*RAZ
-      RZR = (STR+STR)*RAZ
-      RZI = (STI+STI)*RAZ
-      DO 30 I=1,NUI
-        STR = S2R
-        STI = S2I
-        S2R = (DFNU+FNUI)*(RZR*STR-RZI*STI) + S1R
-        S2I = (DFNU+FNUI)*(RZR*STI+RZI*STR) + S1I
-        S1R = STR
-        S1I = STI
-        FNUI = FNUI - 1.0D0
-        IF (IFLAG.GE.3) GO TO 30
-        STR = S2R*CSCRR
-        STI = S2I*CSCRR
-        C1R = DABS(STR)
-        C1I = DABS(STI)
-        C1M = DMAX1(C1R,C1I)
-        IF (C1M.LE.ASCLE) GO TO 30
-        IFLAG = IFLAG+1
-        ASCLE = BRY(IFLAG)
-        S1R = S1R*CSCRR
-        S1I = S1I*CSCRR
-        S2R = STR
-        S2I = STI
-        CSCLR = CSCLR*TOL
-        CSCRR = 1.0D0/CSCLR
-        S1R = S1R*CSCLR
-        S1I = S1I*CSCLR
-        S2R = S2R*CSCLR
-        S2I = S2I*CSCLR
-   30 CONTINUE
-      YR(N) = S2R*CSCRR
-      YI(N) = S2I*CSCRR
-      IF (N.EQ.1) RETURN
-      NL = N - 1
-      FNUI = DBLE(FLOAT(NL))
-      K = NL
-      DO 40 I=1,NL
-        STR = S2R
-        STI = S2I
-        S2R = (FNU+FNUI)*(RZR*STR-RZI*STI) + S1R
-        S2I = (FNU+FNUI)*(RZR*STI+RZI*STR) + S1I
-        S1R = STR
-        S1I = STI
-        STR = S2R*CSCRR
-        STI = S2I*CSCRR
-        YR(K) = STR
-        YI(K) = STI
-        FNUI = FNUI - 1.0D0
-        K = K - 1
-        IF (IFLAG.GE.3) GO TO 40
-        C1R = DABS(STR)
-        C1I = DABS(STI)
-        C1M = DMAX1(C1R,C1I)
-        IF (C1M.LE.ASCLE) GO TO 40
-        IFLAG = IFLAG+1
-        ASCLE = BRY(IFLAG)
-        S1R = S1R*CSCRR
-        S1I = S1I*CSCRR
-        S2R = STR
-        S2I = STI
-        CSCLR = CSCLR*TOL
-        CSCRR = 1.0D0/CSCLR
-        S1R = S1R*CSCLR
-        S1I = S1I*CSCLR
-        S2R = S2R*CSCLR
-        S2I = S2I*CSCLR
-   40 CONTINUE
-      RETURN
-   50 CONTINUE
-      NZ = -1
-      IF(NW.EQ.(-2)) NZ=-2
-      RETURN
-   60 CONTINUE
-      IF (IFORM.EQ.2) GO TO 70
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN
-C     -PI/3.LE.ARG(Z).LE.PI/3
-C-----------------------------------------------------------------------
-      CALL ZUNI1(ZR, ZI, FNU, KODE, N, YR, YI, NW, NLAST, FNUL, TOL,
-     * ELIM, ALIM)
-      GO TO 80
-   70 CONTINUE
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU
-C     APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I
-C     AND HPI=PI/2
-C-----------------------------------------------------------------------
-      CALL ZUNI2(ZR, ZI, FNU, KODE, N, YR, YI, NW, NLAST, FNUL, TOL,
-     * ELIM, ALIM)
-   80 CONTINUE
-      IF (NW.LT.0) GO TO 50
-      NZ = NW
-      RETURN
-   90 CONTINUE
-      NLAST = N
-      RETURN
-      END

amos/zbunk.f

@@ -1,35 +0,0 @@
-      SUBROUTINE ZBUNK(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM,
-     * ALIM)
-C***BEGIN PROLOGUE  ZBUNK
-C***REFER TO  ZBESK,ZBESH
-C
-C     ZBUNK COMPUTES THE K BESSEL FUNCTION FOR FNU.GT.FNUL.
-C     ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR K(FNU,Z)
-C     IN ZUNK1 AND THE EXPANSION FOR H(2,FNU,Z) IN ZUNK2
-C
-C***ROUTINES CALLED  ZUNK1,ZUNK2
-C***END PROLOGUE  ZBUNK
-C     COMPLEX Y,Z
-      DOUBLE PRECISION ALIM, AX, AY, ELIM, FNU, TOL, YI, YR, ZI, ZR
-      INTEGER KODE, MR, N, NZ
-      DIMENSION YR(N), YI(N)
-      NZ = 0
-      AX = DABS(ZR)*1.7321D0
-      AY = DABS(ZI)
-      IF (AY.GT.AX) GO TO 10
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR K(FNU,Z) FOR LARGE FNU APPLIED IN
-C     -PI/3.LE.ARG(Z).LE.PI/3
-C-----------------------------------------------------------------------
-      CALL ZUNK1(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM)
-      GO TO 20
-   10 CONTINUE
-C-----------------------------------------------------------------------
-C     ASYMPTOTIC EXPANSION FOR H(2,FNU,Z*EXP(M*HPI)) FOR LARGE FNU
-C     APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I
-C     AND HPI=PI/2
-C-----------------------------------------------------------------------
-      CALL ZUNK2(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM)
-   20 CONTINUE
-      RETURN
-      END

amos/zdiv.f

@@ -1,19 +0,0 @@
-      SUBROUTINE ZDIV(AR, AI, BR, BI, CR, CI)
-C***BEGIN PROLOGUE  ZDIV
-C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY
-C
-C     DOUBLE PRECISION COMPLEX DIVIDE C=A/B.
-C
-C***ROUTINES CALLED  ZABS
-C***END PROLOGUE  ZDIV
-      DOUBLE PRECISION AR, AI, BR, BI, CR, CI, BM, CA, CB, CC, CD
-      DOUBLE PRECISION ZABS
-      BM = 1.0D0/ZABS(COMPLEX(BR,BI))
-      CC = BR*BM
-      CD = BI*BM
-      CA = (AR*CC+AI*CD)*BM
-      CB = (AI*CC-AR*CD)*BM
-      CR = CA
-      CI = CB
-      RETURN
-      END

amos/zexp.f

@@ -1,16 +0,0 @@
-      SUBROUTINE ZEXP(AR, AI, BR, BI)
-C***BEGIN PROLOGUE  ZEXP
-C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY
-C
-C     DOUBLE PRECISION COMPLEX EXPONENTIAL FUNCTION B=EXP(A)
-C
-C***ROUTINES CALLED  (NONE)
-C***END PROLOGUE  ZEXP
-      DOUBLE PRECISION AR, AI, BR, BI, ZM, CA, CB
-      ZM = DEXP(AR)
-      CA = ZM*DCOS(AI)
-      CB = ZM*DSIN(AI)
-      BR = CA
-      BI = CB
-      RETURN
-      END

amos/zkscl.f

@@ -1,121 +0,0 @@
-      SUBROUTINE ZKSCL(ZRR,ZRI,FNU,N,YR,YI,NZ,RZR,RZI,ASCLE,TOL,ELIM)
-C***BEGIN PROLOGUE  ZKSCL
-C***REFER TO  ZBESK
-C
-C     SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE
-C     ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN
-C     RETURN WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL.
-C
-C***ROUTINES CALLED  ZUCHK,ZABS,ZLOG
-C***END PROLOGUE  ZKSCL
-C     COMPLEX CK,CS,CY,CZERO,RZ,S1,S2,Y,ZR,ZD,CELM
-      DOUBLE PRECISION ACS, AS, ASCLE, CKI, CKR, CSI, CSR, CYI,
-     * CYR, ELIM, FN, FNU, RZI, RZR, STR, S1I, S1R, S2I,
-     * S2R, TOL, YI, YR, ZEROI, ZEROR, ZRI, ZRR, ZABS,
-     * ZDR, ZDI, CELMR, ELM, HELIM, ALAS
-      INTEGER I, IC, IDUM, KK, N, NN, NW, NZ
-      DIMENSION YR(N), YI(N), CYR(2), CYI(2)
-      DATA ZEROR,ZEROI / 0.0D0 , 0.0D0 /
-C
-      NZ = 0
-      IC = 0
-      NN = MIN0(2,N)
-      DO 10 I=1,NN
-        S1R = YR(I)
-        S1I = YI(I)
-        CYR(I) = S1R
-        CYI(I) = S1I
-        AS = ZABS(COMPLEX(S1R,S1I))
-        ACS = -ZRR + DLOG(AS)
-        NZ = NZ + 1
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-        IF (ACS.LT.(-ELIM)) GO TO 10
-        CALL ZLOG(S1R, S1I, CSR, CSI, IDUM)
-        CSR = CSR - ZRR
-        CSI = CSI - ZRI
-        STR = DEXP(CSR)/TOL
-        CSR = STR*DCOS(CSI)
-        CSI = STR*DSIN(CSI)
-        CALL ZUCHK(CSR, CSI, NW, ASCLE, TOL)
-        IF (NW.NE.0) GO TO 10
-        YR(I) = CSR
-        YI(I) = CSI
-        IC = I
-        NZ = NZ - 1
-   10 CONTINUE
-      IF (N.EQ.1) RETURN
-      IF (IC.GT.1) GO TO 20
-      YR(1) = ZEROR
-      YI(1) = ZEROI
-      NZ = 2
-   20 CONTINUE
-      IF (N.EQ.2) RETURN
-      IF (NZ.EQ.0) RETURN
-      FN = FNU + 1.0D0
-      CKR = FN*RZR
-      CKI = FN*RZI
-      S1R = CYR(1)
-      S1I = CYI(1)
-      S2R = CYR(2)
-      S2I = CYI(2)
-      HELIM = 0.5D0*ELIM
-      ELM = DEXP(-ELIM)
-      CELMR = ELM
-      ZDR = ZRR
-      ZDI = ZRI
-C
-C     FIND TWO CONSECUTIVE Y VALUES ON SCALE. SCALE RECURRENCE IF
-C     S2 GETS LARGER THAN EXP(ELIM/2)
-C
-      DO 30 I=3,N
-        KK = I
-        CSR = S2R
-        CSI = S2I
-        S2R = CKR*CSR - CKI*CSI + S1R
-        S2I = CKI*CSR + CKR*CSI + S1I
-        S1R = CSR
-        S1I = CSI
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        AS = ZABS(COMPLEX(S2R,S2I))
-        ALAS = DLOG(AS)
-        ACS = -ZDR + ALAS
-        NZ = NZ + 1
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-        IF (ACS.LT.(-ELIM)) GO TO 25
-        CALL ZLOG(S2R, S2I, CSR, CSI, IDUM)
-        CSR = CSR - ZDR
-        CSI = CSI - ZDI
-        STR = DEXP(CSR)/TOL
-        CSR = STR*DCOS(CSI)
-        CSI = STR*DSIN(CSI)
-        CALL ZUCHK(CSR, CSI, NW, ASCLE, TOL)
-        IF (NW.NE.0) GO TO 25
-        YR(I) = CSR
-        YI(I) = CSI
-        NZ = NZ - 1
-        IF (IC.EQ.KK-1) GO TO 40
-        IC = KK
-        GO TO 30
-   25   CONTINUE
-        IF(ALAS.LT.HELIM) GO TO 30
-        ZDR = ZDR - ELIM
-        S1R = S1R*CELMR
-        S1I = S1I*CELMR
-        S2R = S2R*CELMR
-        S2I = S2I*CELMR
-   30 CONTINUE
-      NZ = N
-      IF(IC.EQ.N) NZ=N-1
-      GO TO 45
-   40 CONTINUE
-      NZ = KK - 2
-   45 CONTINUE
-      DO 50 I=1,NZ
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-   50 CONTINUE
-      RETURN
-      END

amos/zlog.f

@@ -1,41 +0,0 @@
-      SUBROUTINE ZLOG(AR, AI, BR, BI, IERR)
-C***BEGIN PROLOGUE  ZLOG
-C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY
-C
-C     DOUBLE PRECISION COMPLEX LOGARITHM B=CLOG(A)
-C     IERR=0,NORMAL RETURN      IERR=1, Z=CMPLX(0.0,0.0)
-C***ROUTINES CALLED  ZABS
-C***END PROLOGUE  ZLOG
-      DOUBLE PRECISION AR, AI, BR, BI, ZM, DTHETA, DPI, DHPI
-      DOUBLE PRECISION ZABS
-      DATA DPI , DHPI  / 3.141592653589793238462643383D+0,
-     1                   1.570796326794896619231321696D+0/
-C
-      IERR=0
-      IF (AR.EQ.0.0D+0) GO TO 10
-      IF (AI.EQ.0.0D+0) GO TO 20
-      DTHETA = DATAN(AI/AR)
-      IF (DTHETA.LE.0.0D+0) GO TO 40
-      IF (AR.LT.0.0D+0) DTHETA = DTHETA - DPI
-      GO TO 50
-   10 IF (AI.EQ.0.0D+0) GO TO 60
-      BI = DHPI
-      BR = DLOG(DABS(AI))
-      IF (AI.LT.0.0D+0) BI = -BI
-      RETURN
-   20 IF (AR.GT.0.0D+0) GO TO 30
-      BR = DLOG(DABS(AR))
-      BI = DPI
-      RETURN
-   30 BR = DLOG(AR)
-      BI = 0.0D+0
-      RETURN
-   40 IF (AR.LT.0.0D+0) DTHETA = DTHETA + DPI
-   50 ZM = ZABS(COMPLEX(AR,AI))
-      BR = DLOG(ZM)
-      BI = DTHETA
-      RETURN
-   60 CONTINUE
-      IERR=1
-      RETURN
-      END

amos/zmlri.f

@@ -1,204 +0,0 @@
-      SUBROUTINE ZMLRI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL)
-C***BEGIN PROLOGUE  ZMLRI
-C***REFER TO  ZBESI,ZBESK
-C
-C     ZMLRI COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY THE
-C     MILLER ALGORITHM NORMALIZED BY A NEUMANN SERIES.
-C
-C***ROUTINES CALLED  DGAMLN,D1MACH,ZABS,ZEXP,ZLOG,ZMLT
-C***END PROLOGUE  ZMLRI
-C     COMPLEX CK,CNORM,CONE,CTWO,CZERO,PT,P1,P2,RZ,SUM,Y,Z
-      DOUBLE PRECISION ACK, AK, AP, AT, AZ, BK, CKI, CKR, CNORMI,
-     * CNORMR, CONEI, CONER, FKAP, FKK, FLAM, FNF, FNU, PTI, PTR, P1I,
-     * P1R, P2I, P2R, RAZ, RHO, RHO2, RZI, RZR, SCLE, STI, STR, SUMI,
-     * SUMR, TFNF, TOL, TST, YI, YR, ZEROI, ZEROR, ZI, ZR, DGAMLN,
-     * D1MACH, ZABS
-      INTEGER I, IAZ, IDUM, IFNU, INU, ITIME, K, KK, KM, KODE, M, N, NZ
-      DIMENSION YR(N), YI(N)
-      DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 /
-      SCLE = D1MACH(1)/TOL
-      NZ=0
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      IAZ = INT(SNGL(AZ))
-      IFNU = INT(SNGL(FNU))
-      INU = IFNU + N - 1
-      AT = DBLE(FLOAT(IAZ)) + 1.0D0
-      RAZ = 1.0D0/AZ
-      STR = ZR*RAZ
-      STI = -ZI*RAZ
-      CKR = STR*AT*RAZ
-      CKI = STI*AT*RAZ
-      RZR = (STR+STR)*RAZ
-      RZI = (STI+STI)*RAZ
-      P1R = ZEROR
-      P1I = ZEROI
-      P2R = CONER
-      P2I = CONEI
-      ACK = (AT+1.0D0)*RAZ
-      RHO = ACK + DSQRT(ACK*ACK-1.0D0)
-      RHO2 = RHO*RHO
-      TST = (RHO2+RHO2)/((RHO2-1.0D0)*(RHO-1.0D0))
-      TST = TST/TOL
-C-----------------------------------------------------------------------
-C     COMPUTE RELATIVE TRUNCATION ERROR INDEX FOR SERIES
-C-----------------------------------------------------------------------
-      AK = AT
-      DO 10 I=1,80
-        PTR = P2R
-        PTI = P2I
-        P2R = P1R - (CKR*PTR-CKI*PTI)
-        P2I = P1I - (CKI*PTR+CKR*PTI)
-        P1R = PTR
-        P1I = PTI
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        AP = ZABS(COMPLEX(P2R,P2I))
-        IF (AP.GT.TST*AK*AK) GO TO 20
-        AK = AK + 1.0D0
-   10 CONTINUE
-      GO TO 110
-   20 CONTINUE
-      I = I + 1
-      K = 0
-      IF (INU.LT.IAZ) GO TO 40
-C-----------------------------------------------------------------------
-C     COMPUTE RELATIVE TRUNCATION ERROR FOR RATIOS
-C-----------------------------------------------------------------------
-      P1R = ZEROR
-      P1I = ZEROI
-      P2R = CONER
-      P2I = CONEI
-      AT = DBLE(FLOAT(INU)) + 1.0D0
-      STR = ZR*RAZ
-      STI = -ZI*RAZ
-      CKR = STR*AT*RAZ
-      CKI = STI*AT*RAZ
-      ACK = AT*RAZ
-      TST = DSQRT(ACK/TOL)
-      ITIME = 1
-      DO 30 K=1,80
-        PTR = P2R
-        PTI = P2I
-        P2R = P1R - (CKR*PTR-CKI*PTI)
-        P2I = P1I - (CKR*PTI+CKI*PTR)
-        P1R = PTR
-        P1I = PTI
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        AP = ZABS(COMPLEX(P2R,P2I))
-        IF (AP.LT.TST) GO TO 30
-        IF (ITIME.EQ.2) GO TO 40
-        ACK = ZABS(COMPLEX(CKR,CKI))
-        FLAM = ACK + DSQRT(ACK*ACK-1.0D0)
-        FKAP = AP/ZABS(COMPLEX(P1R,P1I))
-        RHO = DMIN1(FLAM,FKAP)
-        TST = TST*DSQRT(RHO/(RHO*RHO-1.0D0))
-        ITIME = 2
-   30 CONTINUE
-      GO TO 110
-   40 CONTINUE
-C-----------------------------------------------------------------------
-C     BACKWARD RECURRENCE AND SUM NORMALIZING RELATION
-C-----------------------------------------------------------------------
-      K = K + 1
-      KK = MAX0(I+IAZ,K+INU)
-      FKK = DBLE(FLOAT(KK))
-      P1R = ZEROR
-      P1I = ZEROI
-C-----------------------------------------------------------------------
-C     SCALE P2 AND SUM BY SCLE
-C-----------------------------------------------------------------------
-      P2R = SCLE
-      P2I = ZEROI
-      FNF = FNU - DBLE(FLOAT(IFNU))
-      TFNF = FNF + FNF
-      BK = DGAMLN(FKK+TFNF+1.0D0,IDUM) - DGAMLN(FKK+1.0D0,IDUM) -
-     * DGAMLN(TFNF+1.0D0,IDUM)
-      BK = DEXP(BK)
-      SUMR = ZEROR
-      SUMI = ZEROI
-      KM = KK - INU
-      DO 50 I=1,KM
-        PTR = P2R
-        PTI = P2I
-        P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI)
-        P2I = P1I + (FKK+FNF)*(RZI*PTR+RZR*PTI)
-        P1R = PTR
-        P1I = PTI
-        AK = 1.0D0 - TFNF/(FKK+TFNF)
-        ACK = BK*AK
-        SUMR = SUMR + (ACK+BK)*P1R
-        SUMI = SUMI + (ACK+BK)*P1I
-        BK = ACK
-        FKK = FKK - 1.0D0
-   50 CONTINUE
-      YR(N) = P2R
-      YI(N) = P2I
-      IF (N.EQ.1) GO TO 70
-      DO 60 I=2,N
-        PTR = P2R
-        PTI = P2I
-        P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI)
-        P2I = P1I + (FKK+FNF)*(RZI*PTR+RZR*PTI)
-        P1R = PTR
-        P1I = PTI
-        AK = 1.0D0 - TFNF/(FKK+TFNF)
-        ACK = BK*AK
-        SUMR = SUMR + (ACK+BK)*P1R
-        SUMI = SUMI + (ACK+BK)*P1I
-        BK = ACK
-        FKK = FKK - 1.0D0
-        M = N - I + 1
-        YR(M) = P2R
-        YI(M) = P2I
-   60 CONTINUE
-   70 CONTINUE
-      IF (IFNU.LE.0) GO TO 90
-      DO 80 I=1,IFNU
-        PTR = P2R
-        PTI = P2I
-        P2R = P1R + (FKK+FNF)*(RZR*PTR-RZI*PTI)
-        P2I = P1I + (FKK+FNF)*(RZR*PTI+RZI*PTR)
-        P1R = PTR
-        P1I = PTI
-        AK = 1.0D0 - TFNF/(FKK+TFNF)
-        ACK = BK*AK
-        SUMR = SUMR + (ACK+BK)*P1R
-        SUMI = SUMI + (ACK+BK)*P1I
-        BK = ACK
-        FKK = FKK - 1.0D0
-   80 CONTINUE
-   90 CONTINUE
-      PTR = ZR
-      PTI = ZI
-      IF (KODE.EQ.2) PTR = ZEROR
-      CALL ZLOG(RZR, RZI, STR, STI, IDUM)
-      P1R = -FNF*STR + PTR
-      P1I = -FNF*STI + PTI
-      AP = DGAMLN(1.0D0+FNF,IDUM)
-      PTR = P1R - AP
-      PTI = P1I
-C-----------------------------------------------------------------------
-C     THE DIVISION CEXP(PT)/(SUM+P2) IS ALTERED TO AVOID OVERFLOW
-C     IN THE DENOMINATOR BY SQUARING LARGE QUANTITIES
-C-----------------------------------------------------------------------
-      P2R = P2R + SUMR
-      P2I = P2I + SUMI
-      AP = ZABS(COMPLEX(P2R,P2I))
-      P1R = 1.0D0/AP
-      CALL ZEXP(PTR, PTI, STR, STI)
-      CKR = STR*P1R
-      CKI = STI*P1R
-      PTR = P2R*P1R
-      PTI = -P2I*P1R
-      CALL ZMLT(CKR, CKI, PTR, PTI, CNORMR, CNORMI)
-      DO 100 I=1,N
-        STR = YR(I)*CNORMR - YI(I)*CNORMI
-        YI(I) = YR(I)*CNORMI + YI(I)*CNORMR
-        YR(I) = STR
-  100 CONTINUE
-      RETURN
-  110 CONTINUE
-      NZ=-2
-      RETURN
-      END

amos/zmlt.f

@@ -1,15 +0,0 @@
-      SUBROUTINE ZMLT(AR, AI, BR, BI, CR, CI)
-C***BEGIN PROLOGUE  ZMLT
-C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY
-C
-C     DOUBLE PRECISION COMPLEX MULTIPLY, C=A*B.
-C
-C***ROUTINES CALLED  (NONE)
-C***END PROLOGUE  ZMLT
-      DOUBLE PRECISION AR, AI, BR, BI, CR, CI, CA, CB
-      CA = AR*BR - AI*BI
-      CB = AR*BI + AI*BR
-      CR = CA
-      CI = CB
-      RETURN
-      END

amos/zrati.f

@@ -1,132 +0,0 @@
-      SUBROUTINE ZRATI(ZR, ZI, FNU, N, CYR, CYI, TOL)
-C***BEGIN PROLOGUE  ZRATI
-C***REFER TO  ZBESI,ZBESK,ZBESH
-C
-C     ZRATI COMPUTES RATIOS OF I BESSEL FUNCTIONS BY BACKWARD
-C     RECURRENCE.  THE STARTING INDEX IS DETERMINED BY FORWARD
-C     RECURRENCE AS DESCRIBED IN J. RES. OF NAT. BUR. OF STANDARDS-B,
-C     MATHEMATICAL SCIENCES, VOL 77B, P111-114, SEPTEMBER, 1973,
-C     BESSEL FUNCTIONS I AND J OF COMPLEX ARGUMENT AND INTEGER ORDER,
-C     BY D. J. SOOKNE.
-C
-C***ROUTINES CALLED  ZABS,ZDIV
-C***END PROLOGUE  ZRATI
-C     COMPLEX Z,CY(1),CONE,CZERO,P1,P2,T1,RZ,PT,CDFNU
-      DOUBLE PRECISION AK, AMAGZ, AP1, AP2, ARG, AZ, CDFNUI, CDFNUR,
-     * CONEI, CONER, CYI, CYR, CZEROI, CZEROR, DFNU, FDNU, FLAM, FNU,
-     * FNUP, PTI, PTR, P1I, P1R, P2I, P2R, RAK, RAP1, RHO, RT2, RZI,
-     * RZR, TEST, TEST1, TOL, TTI, TTR, T1I, T1R, ZI, ZR, ZABS
-      INTEGER I, ID, IDNU, INU, ITIME, K, KK, MAGZ, N
-      DIMENSION CYR(N), CYI(N)
-      DATA CZEROR,CZEROI,CONER,CONEI,RT2/
-     1 0.0D0, 0.0D0, 1.0D0, 0.0D0, 1.41421356237309505D0 /
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      INU = INT(SNGL(FNU))
-      IDNU = INU + N - 1
-      MAGZ = INT(SNGL(AZ))
-      AMAGZ = DBLE(FLOAT(MAGZ+1))
-      FDNU = DBLE(FLOAT(IDNU))
-      FNUP = DMAX1(AMAGZ,FDNU)
-      ID = IDNU - MAGZ - 1
-      ITIME = 1
-      K = 1
-      PTR = 1.0D0/AZ
-      RZR = PTR*(ZR+ZR)*PTR
-      RZI = -PTR*(ZI+ZI)*PTR
-      T1R = RZR*FNUP
-      T1I = RZI*FNUP
-      P2R = -T1R
-      P2I = -T1I
-      P1R = CONER
-      P1I = CONEI
-      T1R = T1R + RZR
-      T1I = T1I + RZI
-      IF (ID.GT.0) ID = 0
-      AP2 = ZABS(COMPLEX(P2R,P2I))
-      AP1 = ZABS(COMPLEX(P1R,P1I))
-C-----------------------------------------------------------------------
-C     THE OVERFLOW TEST ON K(FNU+I-1,Z) BEFORE THE CALL TO CBKNU
-C     GUARANTEES THAT P2 IS ON SCALE. SCALE TEST1 AND ALL SUBSEQUENT
-C     P2 VALUES BY AP1 TO ENSURE THAT AN OVERFLOW DOES NOT OCCUR
-C     PREMATURELY.
-C-----------------------------------------------------------------------
-      ARG = (AP2+AP2)/(AP1*TOL)
-      TEST1 = DSQRT(ARG)
-      TEST = TEST1
-      RAP1 = 1.0D0/AP1
-      P1R = P1R*RAP1
-      P1I = P1I*RAP1
-      P2R = P2R*RAP1
-      P2I = P2I*RAP1
-      AP2 = AP2*RAP1
-   10 CONTINUE
-      K = K + 1
-      AP1 = AP2
-      PTR = P2R
-      PTI = P2I
-      P2R = P1R - (T1R*PTR-T1I*PTI)
-      P2I = P1I - (T1R*PTI+T1I*PTR)
-      P1R = PTR
-      P1I = PTI
-      T1R = T1R + RZR
-      T1I = T1I + RZI
-      AP2 = ZABS(COMPLEX(P2R,P2I))
-      IF (AP1.LE.TEST) GO TO 10
-      IF (ITIME.EQ.2) GO TO 20
-      AK = ZABS(COMPLEX(T1R,T1I)*0.5D0)
-      FLAM = AK + DSQRT(AK*AK-1.0D0)
-      RHO = DMIN1(AP2/AP1,FLAM)
-      TEST = TEST1*DSQRT(RHO/(RHO*RHO-1.0D0))
-      ITIME = 2
-      GO TO 10
-   20 CONTINUE
-      KK = K + 1 - ID
-      AK = DBLE(FLOAT(KK))
-      T1R = AK
-      T1I = CZEROI
-      DFNU = FNU + DBLE(FLOAT(N-1))
-      P1R = 1.0D0/AP2
-      P1I = CZEROI
-      P2R = CZEROR
-      P2I = CZEROI
-      DO 30 I=1,KK
-        PTR = P1R
-        PTI = P1I
-        RAP1 = DFNU + T1R
-        TTR = RZR*RAP1
-        TTI = RZI*RAP1
-        P1R = (PTR*TTR-PTI*TTI) + P2R
-        P1I = (PTR*TTI+PTI*TTR) + P2I
-        P2R = PTR
-        P2I = PTI
-        T1R = T1R - CONER
-   30 CONTINUE
-      IF (P1R.NE.CZEROR .OR. P1I.NE.CZEROI) GO TO 40
-      P1R = TOL
-      P1I = TOL
-   40 CONTINUE
-      CALL ZDIV(P2R, P2I, P1R, P1I, CYR(N), CYI(N))
-      IF (N.EQ.1) RETURN
-      K = N - 1
-      AK = DBLE(FLOAT(K))
-      T1R = AK
-      T1I = CZEROI
-      CDFNUR = FNU*RZR
-      CDFNUI = FNU*RZI
-      DO 60 I=2,N
-        PTR = CDFNUR + (T1R*RZR-T1I*RZI) + CYR(K+1)
-        PTI = CDFNUI + (T1R*RZI+T1I*RZR) + CYI(K+1)
-        AK = ZABS(COMPLEX(PTR,PTI))
-        IF (AK.NE.CZEROR) GO TO 50
-        PTR = TOL
-        PTI = TOL
-        AK = TOL*RT2
-   50   CONTINUE
-        RAK = CONER/AK
-        CYR(K) = RAK*PTR*RAK
-        CYI(K) = -RAK*PTI*RAK
-        T1R = T1R - CONER
-        K = K - 1
-   60 CONTINUE
-      RETURN
-      END

amos/zs1s2.f

@@ -1,49 +0,0 @@
-      SUBROUTINE ZS1S2(ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM,
-     * IUF)
-C***BEGIN PROLOGUE  ZS1S2
-C***REFER TO  ZBESK,ZAIRY
-C
-C     ZS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE
-C     ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON-
-C     TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION.
-C     ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF
-C     MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER
-C     OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE
-C     PRECISION ABOVE THE UNDERFLOW LIMIT.
-C
-C***ROUTINES CALLED  ZABS,ZEXP,ZLOG
-C***END PROLOGUE  ZS1S2
-C     COMPLEX CZERO,C1,S1,S1D,S2,ZR
-      DOUBLE PRECISION AA, ALIM, ALN, ASCLE, AS1, AS2, C1I, C1R, S1DI,
-     * S1DR, S1I, S1R, S2I, S2R, ZEROI, ZEROR, ZRI, ZRR, ZABS
-      INTEGER IUF, IDUM, NZ
-      DATA ZEROR,ZEROI  / 0.0D0 , 0.0D0 /
-      NZ = 0
-      AS1 = ZABS(COMPLEX(S1R,S1I))
-      AS2 = ZABS(COMPLEX(S2R,S2I))
-      IF (S1R.EQ.0.0D0 .AND. S1I.EQ.0.0D0) GO TO 10
-      IF (AS1.EQ.0.0D0) GO TO 10
-      ALN = -ZRR - ZRR + DLOG(AS1)
-      S1DR = S1R
-      S1DI = S1I
-      S1R = ZEROR
-      S1I = ZEROI
-      AS1 = ZEROR
-      IF (ALN.LT.(-ALIM)) GO TO 10
-      CALL ZLOG(S1DR, S1DI, C1R, C1I, IDUM)
-      C1R = C1R - ZRR - ZRR
-      C1I = C1I - ZRI - ZRI
-      CALL ZEXP(C1R, C1I, S1R, S1I)
-      AS1 = ZABS(COMPLEX(S1R,S1I))
-      IUF = IUF + 1
-   10 CONTINUE
-      AA = DMAX1(AS1,AS2)
-      IF (AA.GT.ASCLE) RETURN
-      S1R = ZEROR
-      S1I = ZEROI
-      S2R = ZEROR
-      S2I = ZEROI
-      NZ = 1
-      IUF = 0
-      RETURN
-      END

amos/zseri.f

@@ -1,190 +0,0 @@
-      SUBROUTINE ZSERI(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM,
-     * ALIM)
-C***BEGIN PROLOGUE  ZSERI
-C***REFER TO  ZBESI,ZBESK
-C
-C     ZSERI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY
-C     MEANS OF THE POWER SERIES FOR LARGE CABS(Z) IN THE
-C     REGION CABS(Z).LE.2*SQRT(FNU+1). NZ=0 IS A NORMAL RETURN.
-C     NZ.GT.0 MEANS THAT THE LAST NZ COMPONENTS WERE SET TO ZERO
-C     DUE TO UNDERFLOW. NZ.LT.0 MEANS UNDERFLOW OCCURRED, BUT THE
-C     CONDITION CABS(Z).LE.2*SQRT(FNU+1) WAS VIOLATED AND THE
-C     COMPUTATION MUST BE COMPLETED IN ANOTHER ROUTINE WITH N=N-ABS(NZ).
-C
-C***ROUTINES CALLED  DGAMLN,D1MACH,ZUCHK,ZABS,ZDIV,ZLOG,ZMLT
-C***END PROLOGUE  ZSERI
-C     COMPLEX AK1,CK,COEF,CONE,CRSC,CSCL,CZ,CZERO,HZ,RZ,S1,S2,Y,Z
-      DOUBLE PRECISION AA, ACZ, AK, AK1I, AK1R, ALIM, ARM, ASCLE, ATOL,
-     * AZ, CKI, CKR, COEFI, COEFR, CONEI, CONER, CRSCR, CZI, CZR, DFNU,
-     * ELIM, FNU, FNUP, HZI, HZR, RAZ, RS, RTR1, RZI, RZR, S, SS, STI,
-     * STR, S1I, S1R, S2I, S2R, TOL, YI, YR, WI, WR, ZEROI, ZEROR, ZI,
-     * ZR, DGAMLN, D1MACH, ZABS
-      INTEGER I, IB, IDUM, IFLAG, IL, K, KODE, L, M, N, NN, NZ, NW
-      DIMENSION YR(N), YI(N), WR(2), WI(2)
-      DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 /
-C
-      NZ = 0
-      AZ = ZABS(COMPLEX(ZR,ZI))
-      IF (AZ.EQ.0.0D0) GO TO 160
-      ARM = 1.0D+3*D1MACH(1)
-      RTR1 = DSQRT(ARM)
-      CRSCR = 1.0D0
-      IFLAG = 0
-      IF (AZ.LT.ARM) GO TO 150
-      HZR = 0.5D0*ZR
-      HZI = 0.5D0*ZI
-      CZR = ZEROR
-      CZI = ZEROI
-      IF (AZ.LE.RTR1) GO TO 10
-      CALL ZMLT(HZR, HZI, HZR, HZI, CZR, CZI)
-   10 CONTINUE
-      ACZ = ZABS(COMPLEX(CZR,CZI))
-      NN = N
-      CALL ZLOG(HZR, HZI, CKR, CKI, IDUM)
-   20 CONTINUE
-      DFNU = FNU + DBLE(FLOAT(NN-1))
-      FNUP = DFNU + 1.0D0
-C-----------------------------------------------------------------------
-C     UNDERFLOW TEST
-C-----------------------------------------------------------------------
-      AK1R = CKR*DFNU
-      AK1I = CKI*DFNU
-      AK = DGAMLN(FNUP,IDUM)
-      AK1R = AK1R - AK
-      IF (KODE.EQ.2) AK1R = AK1R - ZR
-      IF (AK1R.GT.(-ELIM)) GO TO 40
-   30 CONTINUE
-      NZ = NZ + 1
-      YR(NN) = ZEROR
-      YI(NN) = ZEROI
-      IF (ACZ.GT.DFNU) GO TO 190
-      NN = NN - 1
-      IF (NN.EQ.0) RETURN
-      GO TO 20
-   40 CONTINUE
-      IF (AK1R.GT.(-ALIM)) GO TO 50
-      IFLAG = 1
-      SS = 1.0D0/TOL
-      CRSCR = TOL
-      ASCLE = ARM*SS
-   50 CONTINUE
-      AA = DEXP(AK1R)
-      IF (IFLAG.EQ.1) AA = AA*SS
-      COEFR = AA*DCOS(AK1I)
-      COEFI = AA*DSIN(AK1I)
-      ATOL = TOL*ACZ/FNUP
-      IL = MIN0(2,NN)
-      DO 90 I=1,IL
-        DFNU = FNU + DBLE(FLOAT(NN-I))
-        FNUP = DFNU + 1.0D0
-        S1R = CONER
-        S1I = CONEI
-        IF (ACZ.LT.TOL*FNUP) GO TO 70
-        AK1R = CONER
-        AK1I = CONEI
-        AK = FNUP + 2.0D0
-        S = FNUP
-        AA = 2.0D0
-   60   CONTINUE
-        RS = 1.0D0/S
-        STR = AK1R*CZR - AK1I*CZI
-        STI = AK1R*CZI + AK1I*CZR
-        AK1R = STR*RS
-        AK1I = STI*RS
-        S1R = S1R + AK1R
-        S1I = S1I + AK1I
-        S = S + AK
-        AK = AK + 2.0D0
-        AA = AA*ACZ*RS
-        IF (AA.GT.ATOL) GO TO 60
-   70   CONTINUE
-        S2R = S1R*COEFR - S1I*COEFI
-        S2I = S1R*COEFI + S1I*COEFR
-        WR(I) = S2R
-        WI(I) = S2I
-        IF (IFLAG.EQ.0) GO TO 80
-        CALL ZUCHK(S2R, S2I, NW, ASCLE, TOL)
-        IF (NW.NE.0) GO TO 30
-   80   CONTINUE
-        M = NN - I + 1
-        YR(M) = S2R*CRSCR
-        YI(M) = S2I*CRSCR
-        IF (I.EQ.IL) GO TO 90
-        CALL ZDIV(COEFR, COEFI, HZR, HZI, STR, STI)
-        COEFR = STR*DFNU
-        COEFI = STI*DFNU
-   90 CONTINUE
-      IF (NN.LE.2) RETURN
-      K = NN - 2
-      AK = DBLE(FLOAT(K))
-      RAZ = 1.0D0/AZ
-      STR = ZR*RAZ
-      STI = -ZI*RAZ
-      RZR = (STR+STR)*RAZ
-      RZI = (STI+STI)*RAZ
-      IF (IFLAG.EQ.1) GO TO 120
-      IB = 3
-  100 CONTINUE
-      DO 110 I=IB,NN
-        YR(K) = (AK+FNU)*(RZR*YR(K+1)-RZI*YI(K+1)) + YR(K+2)
-        YI(K) = (AK+FNU)*(RZR*YI(K+1)+RZI*YR(K+1)) + YI(K+2)
-        AK = AK - 1.0D0
-        K = K - 1
-  110 CONTINUE
-      RETURN
-C-----------------------------------------------------------------------
-C     RECUR BACKWARD WITH SCALED VALUES
-C-----------------------------------------------------------------------
-  120 CONTINUE
-C-----------------------------------------------------------------------
-C     EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION ABOVE THE
-C     UNDERFLOW LIMIT = ASCLE = D1MACH(1)*SS*1.0D+3
-C-----------------------------------------------------------------------
-      S1R = WR(1)
-      S1I = WI(1)
-      S2R = WR(2)
-      S2I = WI(2)
-      DO 130 L=3,NN
-        CKR = S2R
-        CKI = S2I
-        S2R = S1R + (AK+FNU)*(RZR*CKR-RZI*CKI)
-        S2I = S1I + (AK+FNU)*(RZR*CKI+RZI*CKR)
-        S1R = CKR
-        S1I = CKI
-        CKR = S2R*CRSCR
-        CKI = S2I*CRSCR
-        YR(K) = CKR
-        YI(K) = CKI
-        AK = AK - 1.0D0
-        K = K - 1
-        IF (ZABS(COMPLEX(CKR,CKI)).GT.ASCLE) GO TO 140
-  130 CONTINUE
-      RETURN
-  140 CONTINUE
-      IB = L + 1
-      IF (IB.GT.NN) RETURN
-      GO TO 100
-  150 CONTINUE
-      NZ = N
-      IF (FNU.EQ.0.0D0) NZ = NZ - 1
-  160 CONTINUE
-      YR(1) = ZEROR
-      YI(1) = ZEROI
-      IF (FNU.NE.0.0D0) GO TO 170
-      YR(1) = CONER
-      YI(1) = CONEI
-  170 CONTINUE
-      IF (N.EQ.1) RETURN
-      DO 180 I=2,N
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-  180 CONTINUE
-      RETURN
-C-----------------------------------------------------------------------
-C     RETURN WITH NZ.LT.0 IF CABS(Z*Z/4).GT.FNU+N-NZ-1 COMPLETE
-C     THE CALCULATION IN CBINU WITH N=N-IABS(NZ)
-C-----------------------------------------------------------------------
-  190 CONTINUE
-      NZ = -NZ
-      RETURN
-      END

amos/zshch.f

@@ -1,22 +0,0 @@
-      SUBROUTINE ZSHCH(ZR, ZI, CSHR, CSHI, CCHR, CCHI)
-C***BEGIN PROLOGUE  ZSHCH
-C***REFER TO  ZBESK,ZBESH
-C
-C     ZSHCH COMPUTES THE COMPLEX HYPERBOLIC FUNCTIONS CSH=SINH(X+I*Y)
-C     AND CCH=COSH(X+I*Y), WHERE I**2=-1.
-C
-C***ROUTINES CALLED  (NONE)
-C***END PROLOGUE  ZSHCH
-C
-      DOUBLE PRECISION CCHI, CCHR, CH, CN, CSHI, CSHR, SH, SN, ZI, ZR,
-     * DCOSH, DSINH
-      SH = DSINH(ZR)
-      CH = DCOSH(ZR)
-      SN = DSIN(ZI)
-      CN = DCOS(ZI)
-      CSHR = SH*CN
-      CSHI = CH*SN
-      CCHR = CH*CN
-      CCHI = SH*SN
-      RETURN
-      END

amos/zsqrt.f

@@ -1,44 +0,0 @@
-      SUBROUTINE ZSQRT(AR, AI, BR, BI)
-C***BEGIN PROLOGUE  ZSQRT
-C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZBESY,ZAIRY,ZBIRY
-C
-C     DOUBLE PRECISION COMPLEX SQUARE ROOT, B=CSQRT(A)
-C
-C***ROUTINES CALLED  ZABS
-C***END PROLOGUE  ZSQRT
-      DOUBLE PRECISION AR, AI, BR, BI, ZM, DTHETA, DPI, DRT
-      DOUBLE PRECISION ZABS
-      DATA DRT , DPI / 7.071067811865475244008443621D-1,
-     1                 3.141592653589793238462643383D+0/
-      ZM = ZABS(COMPLEX(AR,AI))
-      ZM = DSQRT(ZM)
-      IF (AR.EQ.0.0D+0) GO TO 10
-      IF (AI.EQ.0.0D+0) GO TO 20
-      DTHETA = DATAN(AI/AR)
-      IF (DTHETA.LE.0.0D+0) GO TO 40
-      IF (AR.LT.0.0D+0) DTHETA = DTHETA - DPI
-      GO TO 50
-   10 IF (AI.GT.0.0D+0) GO TO 60
-      IF (AI.LT.0.0D+0) GO TO 70
-      BR = 0.0D+0
-      BI = 0.0D+0
-      RETURN
-   20 IF (AR.GT.0.0D+0) GO TO 30
-      BR = 0.0D+0
-      BI = DSQRT(DABS(AR))
-      RETURN
-   30 BR = DSQRT(AR)
-      BI = 0.0D+0
-      RETURN
-   40 IF (AR.LT.0.0D+0) DTHETA = DTHETA + DPI
-   50 DTHETA = DTHETA*0.5D+0
-      BR = ZM*DCOS(DTHETA)
-      BI = ZM*DSIN(DTHETA)
-      RETURN
-   60 BR = ZM*DRT
-      BI = ZM*DRT
-      RETURN
-   70 BR = ZM*DRT
-      BI = -ZM*DRT
-      RETURN
-      END

amos/zuchk.f

@@ -1,28 +0,0 @@
-      SUBROUTINE ZUCHK(YR, YI, NZ, ASCLE, TOL)
-C***BEGIN PROLOGUE  ZUCHK
-C***REFER TO ZSERI,ZUOIK,ZUNK1,ZUNK2,ZUNI1,ZUNI2,ZKSCL
-C
-C      Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN
-C      EXP(-ALIM)=ASCLE=1.0E+3*D1MACH(1)/TOL. THE TEST IS MADE TO SEE
-C      IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDERFLOW
-C      WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED
-C      IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE
-C      OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE
-C      ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED.
-C
-C***ROUTINES CALLED  (NONE)
-C***END PROLOGUE  ZUCHK
-C
-C     COMPLEX Y
-      DOUBLE PRECISION ASCLE, SS, ST, TOL, WR, WI, YR, YI
-      INTEGER NZ
-      NZ = 0
-      WR = DABS(YR)
-      WI = DABS(YI)
-      ST = DMIN1(WR,WI)
-      IF (ST.GT.ASCLE) RETURN
-      SS = DMAX1(WR,WI)
-      ST = ST/TOL
-      IF (SS.LT.ST) NZ = 1
-      RETURN
-      END

amos/zunhj.f

@@ -1,714 +0,0 @@
-      SUBROUTINE ZUNHJ(ZR, ZI, FNU, IPMTR, TOL, PHIR, PHII, ARGR, ARGI,
-     * ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
-C***BEGIN PROLOGUE  ZUNHJ
-C***REFER TO  ZBESI,ZBESK
-C
-C     REFERENCES
-C         HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A.
-C         STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9.
-C
-C         ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC
-C         PRESS, N.Y., 1974, PAGE 420
-C
-C     ABSTRACT
-C         ZUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) =
-C         J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU
-C         BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION
-C
-C         C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) )
-C
-C         FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS
-C         AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE.
-C
-C               (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2,
-C
-C         ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING
-C         PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY.
-C
-C         MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND
-C         MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR=
-C         1 COMPUTES ALL EXCEPT ASUM AND BSUM.
-C
-C***ROUTINES CALLED  ZABS,ZDIV,ZLOG,ZSQRT,D1MACH
-C***END PROLOGUE  ZUNHJ
-C     COMPLEX ARG,ASUM,BSUM,CFNU,CONE,CR,CZERO,DR,P,PHI,PRZTH,PTFN,
-C    *RFN13,RTZTA,RZTH,SUMA,SUMB,TFN,T2,UP,W,W2,Z,ZA,ZB,ZC,ZETA,ZETA1,
-C    *ZETA2,ZTH
-      DOUBLE PRECISION ALFA, ANG, AP, AR, ARGI, ARGR, ASUMI, ASUMR,
-     * ATOL, AW2, AZTH, BETA, BR, BSUMI, BSUMR, BTOL, C, CONEI, CONER,
-     * CRI, CRR, DRI, DRR, EX1, EX2, FNU, FN13, FN23, GAMA, GPI, HPI,
-     * PHII, PHIR, PI, PP, PR, PRZTHI, PRZTHR, PTFNI, PTFNR, RAW, RAW2,
-     * RAZTH, RFNU, RFNU2, RFN13, RTZTI, RTZTR, RZTHI, RZTHR, STI, STR,
-     * SUMAI, SUMAR, SUMBI, SUMBR, TEST, TFNI, TFNR, THPI, TOL, TZAI,
-     * TZAR, T2I, T2R, UPI, UPR, WI, WR, W2I, W2R, ZAI, ZAR, ZBI, ZBR,
-     * ZCI, ZCR, ZEROI, ZEROR, ZETAI, ZETAR, ZETA1I, ZETA1R, ZETA2I,
-     * ZETA2R, ZI, ZR, ZTHI, ZTHR, ZABS, AC, D1MACH
-      INTEGER IAS, IBS, IPMTR, IS, J, JR, JU, K, KMAX, KP1, KS, L, LR,
-     * LRP1, L1, L2, M, IDUM
-      DIMENSION AR(14), BR(14), C(105), ALFA(180), BETA(210), GAMA(30),
-     * AP(30), PR(30), PI(30), UPR(14), UPI(14), CRR(14), CRI(14),
-     * DRR(14), DRI(14)
-      DATA AR(1), AR(2), AR(3), AR(4), AR(5), AR(6), AR(7), AR(8),
-     1     AR(9), AR(10), AR(11), AR(12), AR(13), AR(14)/
-     2     1.00000000000000000D+00,     1.04166666666666667D-01,
-     3     8.35503472222222222D-02,     1.28226574556327160D-01,
-     4     2.91849026464140464D-01,     8.81627267443757652D-01,
-     5     3.32140828186276754D+00,     1.49957629868625547D+01,
-     6     7.89230130115865181D+01,     4.74451538868264323D+02,
-     7     3.20749009089066193D+03,     2.40865496408740049D+04,
-     8     1.98923119169509794D+05,     1.79190200777534383D+06/
-      DATA BR(1), BR(2), BR(3), BR(4), BR(5), BR(6), BR(7), BR(8),
-     1     BR(9), BR(10), BR(11), BR(12), BR(13), BR(14)/
-     2     1.00000000000000000D+00,    -1.45833333333333333D-01,
-     3    -9.87413194444444444D-02,    -1.43312053915895062D-01,
-     4    -3.17227202678413548D-01,    -9.42429147957120249D-01,
-     5    -3.51120304082635426D+00,    -1.57272636203680451D+01,
-     6    -8.22814390971859444D+01,    -4.92355370523670524D+02,
-     7    -3.31621856854797251D+03,    -2.48276742452085896D+04,
-     8    -2.04526587315129788D+05,    -1.83844491706820990D+06/
-      DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10),
-     1     C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18),
-     2     C(19), C(20), C(21), C(22), C(23), C(24)/
-     3     1.00000000000000000D+00,    -2.08333333333333333D-01,
-     4     1.25000000000000000D-01,     3.34201388888888889D-01,
-     5    -4.01041666666666667D-01,     7.03125000000000000D-02,
-     6    -1.02581259645061728D+00,     1.84646267361111111D+00,
-     7    -8.91210937500000000D-01,     7.32421875000000000D-02,
-     8     4.66958442342624743D+00,    -1.12070026162229938D+01,
-     9     8.78912353515625000D+00,    -2.36408691406250000D+00,
-     A     1.12152099609375000D-01,    -2.82120725582002449D+01,
-     B     8.46362176746007346D+01,    -9.18182415432400174D+01,
-     C     4.25349987453884549D+01,    -7.36879435947963170D+00,
-     D     2.27108001708984375D-01,     2.12570130039217123D+02,
-     E    -7.65252468141181642D+02,     1.05999045252799988D+03/
-      DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32),
-     1     C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40),
-     2     C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/
-     3    -6.99579627376132541D+02,     2.18190511744211590D+02,
-     4    -2.64914304869515555D+01,     5.72501420974731445D-01,
-     5    -1.91945766231840700D+03,     8.06172218173730938D+03,
-     6    -1.35865500064341374D+04,     1.16553933368645332D+04,
-     7    -5.30564697861340311D+03,     1.20090291321635246D+03,
-     8    -1.08090919788394656D+02,     1.72772750258445740D+00,
-     9     2.02042913309661486D+04,    -9.69805983886375135D+04,
-     A     1.92547001232531532D+05,    -2.03400177280415534D+05,
-     B     1.22200464983017460D+05,    -4.11926549688975513D+04,
-     C     7.10951430248936372D+03,    -4.93915304773088012D+02,
-     D     6.07404200127348304D+00,    -2.42919187900551333D+05,
-     E     1.31176361466297720D+06,    -2.99801591853810675D+06/
-      DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56),
-     1     C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64),
-     2     C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/
-     3     3.76327129765640400D+06,    -2.81356322658653411D+06,
-     4     1.26836527332162478D+06,    -3.31645172484563578D+05,
-     5     4.52187689813627263D+04,    -2.49983048181120962D+03,
-     6     2.43805296995560639D+01,     3.28446985307203782D+06,
-     7    -1.97068191184322269D+07,     5.09526024926646422D+07,
-     8    -7.41051482115326577D+07,     6.63445122747290267D+07,
-     9    -3.75671766607633513D+07,     1.32887671664218183D+07,
-     A    -2.78561812808645469D+06,     3.08186404612662398D+05,
-     B    -1.38860897537170405D+04,     1.10017140269246738D+02,
-     C    -4.93292536645099620D+07,     3.25573074185765749D+08,
-     D    -9.39462359681578403D+08,     1.55359689957058006D+09,
-     E    -1.62108055210833708D+09,     1.10684281682301447D+09/
-      DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80),
-     1     C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88),
-     2     C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/
-     3    -4.95889784275030309D+08,     1.42062907797533095D+08,
-     4    -2.44740627257387285D+07,     2.24376817792244943D+06,
-     5    -8.40054336030240853D+04,     5.51335896122020586D+02,
-     6     8.14789096118312115D+08,    -5.86648149205184723D+09,
-     7     1.86882075092958249D+10,    -3.46320433881587779D+10,
-     8     4.12801855797539740D+10,    -3.30265997498007231D+10,
-     9     1.79542137311556001D+10,    -6.56329379261928433D+09,
-     A     1.55927986487925751D+09,    -2.25105661889415278D+08,
-     B     1.73951075539781645D+07,    -5.49842327572288687D+05,
-     C     3.03809051092238427D+03,    -1.46792612476956167D+10,
-     D     1.14498237732025810D+11,    -3.99096175224466498D+11,
-     E     8.19218669548577329D+11,    -1.09837515608122331D+12/
-      DATA C(97), C(98), C(99), C(100), C(101), C(102), C(103), C(104),
-     1     C(105)/
-     2     1.00815810686538209D+12,    -6.45364869245376503D+11,
-     3     2.87900649906150589D+11,    -8.78670721780232657D+10,
-     4     1.76347306068349694D+10,    -2.16716498322379509D+09,
-     5     1.43157876718888981D+08,    -3.87183344257261262D+06,
-     6     1.82577554742931747D+04/
-      DATA ALFA(1), ALFA(2), ALFA(3), ALFA(4), ALFA(5), ALFA(6),
-     1     ALFA(7), ALFA(8), ALFA(9), ALFA(10), ALFA(11), ALFA(12),
-     2     ALFA(13), ALFA(14), ALFA(15), ALFA(16), ALFA(17), ALFA(18),
-     3     ALFA(19), ALFA(20), ALFA(21), ALFA(22)/
-     4    -4.44444444444444444D-03,    -9.22077922077922078D-04,
-     5    -8.84892884892884893D-05,     1.65927687832449737D-04,
-     6     2.46691372741792910D-04,     2.65995589346254780D-04,
-     7     2.61824297061500945D-04,     2.48730437344655609D-04,
-     8     2.32721040083232098D-04,     2.16362485712365082D-04,
-     9     2.00738858762752355D-04,     1.86267636637545172D-04,
-     A     1.73060775917876493D-04,     1.61091705929015752D-04,
-     B     1.50274774160908134D-04,     1.40503497391269794D-04,
-     C     1.31668816545922806D-04,     1.23667445598253261D-04,
-     D     1.16405271474737902D-04,     1.09798298372713369D-04,
-     E     1.03772410422992823D-04,     9.82626078369363448D-05/
-      DATA ALFA(23), ALFA(24), ALFA(25), ALFA(26), ALFA(27), ALFA(28),
-     1     ALFA(29), ALFA(30), ALFA(31), ALFA(32), ALFA(33), ALFA(34),
-     2     ALFA(35), ALFA(36), ALFA(37), ALFA(38), ALFA(39), ALFA(40),
-     3     ALFA(41), ALFA(42), ALFA(43), ALFA(44)/
-     4     9.32120517249503256D-05,     8.85710852478711718D-05,
-     5     8.42963105715700223D-05,     8.03497548407791151D-05,
-     6     7.66981345359207388D-05,     7.33122157481777809D-05,
-     7     7.01662625163141333D-05,     6.72375633790160292D-05,
-     8     6.93735541354588974D-04,     2.32241745182921654D-04,
-     9    -1.41986273556691197D-05,    -1.16444931672048640D-04,
-     A    -1.50803558053048762D-04,    -1.55121924918096223D-04,
-     B    -1.46809756646465549D-04,    -1.33815503867491367D-04,
-     C    -1.19744975684254051D-04,    -1.06184319207974020D-04,
-     D    -9.37699549891194492D-05,    -8.26923045588193274D-05,
-     E    -7.29374348155221211D-05,    -6.44042357721016283D-05/
-      DATA ALFA(45), ALFA(46), ALFA(47), ALFA(48), ALFA(49), ALFA(50),
-     1     ALFA(51), ALFA(52), ALFA(53), ALFA(54), ALFA(55), ALFA(56),
-     2     ALFA(57), ALFA(58), ALFA(59), ALFA(60), ALFA(61), ALFA(62),
-     3     ALFA(63), ALFA(64), ALFA(65), ALFA(66)/
-     4    -5.69611566009369048D-05,    -5.04731044303561628D-05,
-     5    -4.48134868008882786D-05,    -3.98688727717598864D-05,
-     6    -3.55400532972042498D-05,    -3.17414256609022480D-05,
-     7    -2.83996793904174811D-05,    -2.54522720634870566D-05,
-     8    -2.28459297164724555D-05,    -2.05352753106480604D-05,
-     9    -1.84816217627666085D-05,    -1.66519330021393806D-05,
-     A    -1.50179412980119482D-05,    -1.35554031379040526D-05,
-     B    -1.22434746473858131D-05,    -1.10641884811308169D-05,
-     C    -3.54211971457743841D-04,    -1.56161263945159416D-04,
-     D     3.04465503594936410D-05,     1.30198655773242693D-04,
-     E     1.67471106699712269D-04,     1.70222587683592569D-04/
-      DATA ALFA(67), ALFA(68), ALFA(69), ALFA(70), ALFA(71), ALFA(72),
-     1     ALFA(73), ALFA(74), ALFA(75), ALFA(76), ALFA(77), ALFA(78),
-     2     ALFA(79), ALFA(80), ALFA(81), ALFA(82), ALFA(83), ALFA(84),
-     3     ALFA(85), ALFA(86), ALFA(87), ALFA(88)/
-     4     1.56501427608594704D-04,     1.36339170977445120D-04,
-     5     1.14886692029825128D-04,     9.45869093034688111D-05,
-     6     7.64498419250898258D-05,     6.07570334965197354D-05,
-     7     4.74394299290508799D-05,     3.62757512005344297D-05,
-     8     2.69939714979224901D-05,     1.93210938247939253D-05,
-     9     1.30056674793963203D-05,     7.82620866744496661D-06,
-     A     3.59257485819351583D-06,     1.44040049814251817D-07,
-     B    -2.65396769697939116D-06,    -4.91346867098485910D-06,
-     C    -6.72739296091248287D-06,    -8.17269379678657923D-06,
-     D    -9.31304715093561232D-06,    -1.02011418798016441D-05,
-     E    -1.08805962510592880D-05,    -1.13875481509603555D-05/
-      DATA ALFA(89), ALFA(90), ALFA(91), ALFA(92), ALFA(93), ALFA(94),
-     1     ALFA(95), ALFA(96), ALFA(97), ALFA(98), ALFA(99), ALFA(100),
-     2     ALFA(101), ALFA(102), ALFA(103), ALFA(104), ALFA(105),
-     3     ALFA(106), ALFA(107), ALFA(108), ALFA(109), ALFA(110)/
-     4    -1.17519675674556414D-05,    -1.19987364870944141D-05,
-     5     3.78194199201772914D-04,     2.02471952761816167D-04,
-     6    -6.37938506318862408D-05,    -2.38598230603005903D-04,
-     7    -3.10916256027361568D-04,    -3.13680115247576316D-04,
-     8    -2.78950273791323387D-04,    -2.28564082619141374D-04,
-     9    -1.75245280340846749D-04,    -1.25544063060690348D-04,
-     A    -8.22982872820208365D-05,    -4.62860730588116458D-05,
-     B    -1.72334302366962267D-05,     5.60690482304602267D-06,
-     C     2.31395443148286800D-05,     3.62642745856793957D-05,
-     D     4.58006124490188752D-05,     5.24595294959114050D-05,
-     E     5.68396208545815266D-05,     5.94349820393104052D-05/
-      DATA ALFA(111), ALFA(112), ALFA(113), ALFA(114), ALFA(115),
-     1     ALFA(116), ALFA(117), ALFA(118), ALFA(119), ALFA(120),
-     2     ALFA(121), ALFA(122), ALFA(123), ALFA(124), ALFA(125),
-     3     ALFA(126), ALFA(127), ALFA(128), ALFA(129), ALFA(130)/
-     4     6.06478527578421742D-05,     6.08023907788436497D-05,
-     5     6.01577894539460388D-05,     5.89199657344698500D-05,
-     6     5.72515823777593053D-05,     5.52804375585852577D-05,
-     7     5.31063773802880170D-05,     5.08069302012325706D-05,
-     8     4.84418647620094842D-05,     4.60568581607475370D-05,
-     9    -6.91141397288294174D-04,    -4.29976633058871912D-04,
-     A     1.83067735980039018D-04,     6.60088147542014144D-04,
-     B     8.75964969951185931D-04,     8.77335235958235514D-04,
-     C     7.49369585378990637D-04,     5.63832329756980918D-04,
-     D     3.68059319971443156D-04,     1.88464535514455599D-04/
-      DATA ALFA(131), ALFA(132), ALFA(133), ALFA(134), ALFA(135),
-     1     ALFA(136), ALFA(137), ALFA(138), ALFA(139), ALFA(140),
-     2     ALFA(141), ALFA(142), ALFA(143), ALFA(144), ALFA(145),
-     3     ALFA(146), ALFA(147), ALFA(148), ALFA(149), ALFA(150)/
-     4     3.70663057664904149D-05,    -8.28520220232137023D-05,
-     5    -1.72751952869172998D-04,    -2.36314873605872983D-04,
-     6    -2.77966150694906658D-04,    -3.02079514155456919D-04,
-     7    -3.12594712643820127D-04,    -3.12872558758067163D-04,
-     8    -3.05678038466324377D-04,    -2.93226470614557331D-04,
-     9    -2.77255655582934777D-04,    -2.59103928467031709D-04,
-     A    -2.39784014396480342D-04,    -2.20048260045422848D-04,
-     B    -2.00443911094971498D-04,    -1.81358692210970687D-04,
-     C    -1.63057674478657464D-04,    -1.45712672175205844D-04,
-     D    -1.29425421983924587D-04,    -1.14245691942445952D-04/
-      DATA ALFA(151), ALFA(152), ALFA(153), ALFA(154), ALFA(155),
-     1     ALFA(156), ALFA(157), ALFA(158), ALFA(159), ALFA(160),
-     2     ALFA(161), ALFA(162), ALFA(163), ALFA(164), ALFA(165),
-     3     ALFA(166), ALFA(167), ALFA(168), ALFA(169), ALFA(170)/
-     4     1.92821964248775885D-03,     1.35592576302022234D-03,
-     5    -7.17858090421302995D-04,    -2.58084802575270346D-03,
-     6    -3.49271130826168475D-03,    -3.46986299340960628D-03,
-     7    -2.82285233351310182D-03,    -1.88103076404891354D-03,
-     8    -8.89531718383947600D-04,     3.87912102631035228D-06,
-     9     7.28688540119691412D-04,     1.26566373053457758D-03,
-     A     1.62518158372674427D-03,     1.83203153216373172D-03,
-     B     1.91588388990527909D-03,     1.90588846755546138D-03,
-     C     1.82798982421825727D-03,     1.70389506421121530D-03,
-     D     1.55097127171097686D-03,     1.38261421852276159D-03/
-      DATA ALFA(171), ALFA(172), ALFA(173), ALFA(174), ALFA(175),
-     1     ALFA(176), ALFA(177), ALFA(178), ALFA(179), ALFA(180)/
-     2     1.20881424230064774D-03,     1.03676532638344962D-03,
-     3     8.71437918068619115D-04,     7.16080155297701002D-04,
-     4     5.72637002558129372D-04,     4.42089819465802277D-04,
-     5     3.24724948503090564D-04,     2.20342042730246599D-04,
-     6     1.28412898401353882D-04,     4.82005924552095464D-05/
-      DATA BETA(1), BETA(2), BETA(3), BETA(4), BETA(5), BETA(6),
-     1     BETA(7), BETA(8), BETA(9), BETA(10), BETA(11), BETA(12),
-     2     BETA(13), BETA(14), BETA(15), BETA(16), BETA(17), BETA(18),
-     3     BETA(19), BETA(20), BETA(21), BETA(22)/
-     4     1.79988721413553309D-02,     5.59964911064388073D-03,
-     5     2.88501402231132779D-03,     1.80096606761053941D-03,
-     6     1.24753110589199202D-03,     9.22878876572938311D-04,
-     7     7.14430421727287357D-04,     5.71787281789704872D-04,
-     8     4.69431007606481533D-04,     3.93232835462916638D-04,
-     9     3.34818889318297664D-04,     2.88952148495751517D-04,
-     A     2.52211615549573284D-04,     2.22280580798883327D-04,
-     B     1.97541838033062524D-04,     1.76836855019718004D-04,
-     C     1.59316899661821081D-04,     1.44347930197333986D-04,
-     D     1.31448068119965379D-04,     1.20245444949302884D-04,
-     E     1.10449144504599392D-04,     1.01828770740567258D-04/
-      DATA BETA(23), BETA(24), BETA(25), BETA(26), BETA(27), BETA(28),
-     1     BETA(29), BETA(30), BETA(31), BETA(32), BETA(33), BETA(34),
-     2     BETA(35), BETA(36), BETA(37), BETA(38), BETA(39), BETA(40),
-     3     BETA(41), BETA(42), BETA(43), BETA(44)/
-     4     9.41998224204237509D-05,     8.74130545753834437D-05,
-     5     8.13466262162801467D-05,     7.59002269646219339D-05,
-     6     7.09906300634153481D-05,     6.65482874842468183D-05,
-     7     6.25146958969275078D-05,     5.88403394426251749D-05,
-     8    -1.49282953213429172D-03,    -8.78204709546389328D-04,
-     9    -5.02916549572034614D-04,    -2.94822138512746025D-04,
-     A    -1.75463996970782828D-04,    -1.04008550460816434D-04,
-     B    -5.96141953046457895D-05,    -3.12038929076098340D-05,
-     C    -1.26089735980230047D-05,    -2.42892608575730389D-07,
-     D     8.05996165414273571D-06,     1.36507009262147391D-05,
-     E     1.73964125472926261D-05,     1.98672978842133780D-05/
-      DATA BETA(45), BETA(46), BETA(47), BETA(48), BETA(49), BETA(50),
-     1     BETA(51), BETA(52), BETA(53), BETA(54), BETA(55), BETA(56),
-     2     BETA(57), BETA(58), BETA(59), BETA(60), BETA(61), BETA(62),
-     3     BETA(63), BETA(64), BETA(65), BETA(66)/
-     4     2.14463263790822639D-05,     2.23954659232456514D-05,
-     5     2.28967783814712629D-05,     2.30785389811177817D-05,
-     6     2.30321976080909144D-05,     2.28236073720348722D-05,
-     7     2.25005881105292418D-05,     2.20981015361991429D-05,
-     8     2.16418427448103905D-05,     2.11507649256220843D-05,
-     9     2.06388749782170737D-05,     2.01165241997081666D-05,
-     A     1.95913450141179244D-05,     1.90689367910436740D-05,
-     B     1.85533719641636667D-05,     1.80475722259674218D-05,
-     C     5.52213076721292790D-04,     4.47932581552384646D-04,
-     D     2.79520653992020589D-04,     1.52468156198446602D-04,
-     E     6.93271105657043598D-05,     1.76258683069991397D-05/
-      DATA BETA(67), BETA(68), BETA(69), BETA(70), BETA(71), BETA(72),
-     1     BETA(73), BETA(74), BETA(75), BETA(76), BETA(77), BETA(78),
-     2     BETA(79), BETA(80), BETA(81), BETA(82), BETA(83), BETA(84),
-     3     BETA(85), BETA(86), BETA(87), BETA(88)/
-     4    -1.35744996343269136D-05,    -3.17972413350427135D-05,
-     5    -4.18861861696693365D-05,    -4.69004889379141029D-05,
-     6    -4.87665447413787352D-05,    -4.87010031186735069D-05,
-     7    -4.74755620890086638D-05,    -4.55813058138628452D-05,
-     8    -4.33309644511266036D-05,    -4.09230193157750364D-05,
-     9    -3.84822638603221274D-05,    -3.60857167535410501D-05,
-     A    -3.37793306123367417D-05,    -3.15888560772109621D-05,
-     B    -2.95269561750807315D-05,    -2.75978914828335759D-05,
-     C    -2.58006174666883713D-05,    -2.41308356761280200D-05,
-     D    -2.25823509518346033D-05,    -2.11479656768912971D-05,
-     E    -1.98200638885294927D-05,    -1.85909870801065077D-05/
-      DATA BETA(89), BETA(90), BETA(91), BETA(92), BETA(93), BETA(94),
-     1     BETA(95), BETA(96), BETA(97), BETA(98), BETA(99), BETA(100),
-     2     BETA(101), BETA(102), BETA(103), BETA(104), BETA(105),
-     3     BETA(106), BETA(107), BETA(108), BETA(109), BETA(110)/
-     4    -1.74532699844210224D-05,    -1.63997823854497997D-05,
-     5    -4.74617796559959808D-04,    -4.77864567147321487D-04,
-     6    -3.20390228067037603D-04,    -1.61105016119962282D-04,
-     7    -4.25778101285435204D-05,     3.44571294294967503D-05,
-     8     7.97092684075674924D-05,     1.03138236708272200D-04,
-     9     1.12466775262204158D-04,     1.13103642108481389D-04,
-     A     1.08651634848774268D-04,     1.01437951597661973D-04,
-     B     9.29298396593363896D-05,     8.40293133016089978D-05,
-     C     7.52727991349134062D-05,     6.69632521975730872D-05,
-     D     5.92564547323194704D-05,     5.22169308826975567D-05,
-     E     4.58539485165360646D-05,     4.01445513891486808D-05/
-      DATA BETA(111), BETA(112), BETA(113), BETA(114), BETA(115),
-     1     BETA(116), BETA(117), BETA(118), BETA(119), BETA(120),
-     2     BETA(121), BETA(122), BETA(123), BETA(124), BETA(125),
-     3     BETA(126), BETA(127), BETA(128), BETA(129), BETA(130)/
-     4     3.50481730031328081D-05,     3.05157995034346659D-05,
-     5     2.64956119950516039D-05,     2.29363633690998152D-05,
-     6     1.97893056664021636D-05,     1.70091984636412623D-05,
-     7     1.45547428261524004D-05,     1.23886640995878413D-05,
-     8     1.04775876076583236D-05,     8.79179954978479373D-06,
-     9     7.36465810572578444D-04,     8.72790805146193976D-04,
-     A     6.22614862573135066D-04,     2.85998154194304147D-04,
-     B     3.84737672879366102D-06,    -1.87906003636971558D-04,
-     C    -2.97603646594554535D-04,    -3.45998126832656348D-04,
-     D    -3.53382470916037712D-04,    -3.35715635775048757D-04/
-      DATA BETA(131), BETA(132), BETA(133), BETA(134), BETA(135),
-     1     BETA(136), BETA(137), BETA(138), BETA(139), BETA(140),
-     2     BETA(141), BETA(142), BETA(143), BETA(144), BETA(145),
-     3     BETA(146), BETA(147), BETA(148), BETA(149), BETA(150)/
-     4    -3.04321124789039809D-04,    -2.66722723047612821D-04,
-     5    -2.27654214122819527D-04,    -1.89922611854562356D-04,
-     6    -1.55058918599093870D-04,    -1.23778240761873630D-04,
-     7    -9.62926147717644187D-05,    -7.25178327714425337D-05,
-     8    -5.22070028895633801D-05,    -3.50347750511900522D-05,
-     9    -2.06489761035551757D-05,    -8.70106096849767054D-06,
-     A     1.13698686675100290D-06,     9.16426474122778849D-06,
-     B     1.56477785428872620D-05,     2.08223629482466847D-05,
-     C     2.48923381004595156D-05,     2.80340509574146325D-05,
-     D     3.03987774629861915D-05,     3.21156731406700616D-05/
-      DATA BETA(151), BETA(152), BETA(153), BETA(154), BETA(155),
-     1     BETA(156), BETA(157), BETA(158), BETA(159), BETA(160),
-     2     BETA(161), BETA(162), BETA(163), BETA(164), BETA(165),
-     3     BETA(166), BETA(167), BETA(168), BETA(169), BETA(170)/
-     4    -1.80182191963885708D-03,    -2.43402962938042533D-03,
-     5    -1.83422663549856802D-03,    -7.62204596354009765D-04,
-     6     2.39079475256927218D-04,     9.49266117176881141D-04,
-     7     1.34467449701540359D-03,     1.48457495259449178D-03,
-     8     1.44732339830617591D-03,     1.30268261285657186D-03,
-     9     1.10351597375642682D-03,     8.86047440419791759D-04,
-     A     6.73073208165665473D-04,     4.77603872856582378D-04,
-     B     3.05991926358789362D-04,     1.60315694594721630D-04,
-     C     4.00749555270613286D-05,    -5.66607461635251611D-05,
-     D    -1.32506186772982638D-04,    -1.90296187989614057D-04/
-      DATA BETA(171), BETA(172), BETA(173), BETA(174), BETA(175),
-     1     BETA(176), BETA(177), BETA(178), BETA(179), BETA(180),
-     2     BETA(181), BETA(182), BETA(183), BETA(184), BETA(185),
-     3     BETA(186), BETA(187), BETA(188), BETA(189), BETA(190)/
-     4    -2.32811450376937408D-04,    -2.62628811464668841D-04,
-     5    -2.82050469867598672D-04,    -2.93081563192861167D-04,
-     6    -2.97435962176316616D-04,    -2.96557334239348078D-04,
-     7    -2.91647363312090861D-04,    -2.83696203837734166D-04,
-     8    -2.73512317095673346D-04,    -2.61750155806768580D-04,
-     9     6.38585891212050914D-03,     9.62374215806377941D-03,
-     A     7.61878061207001043D-03,     2.83219055545628054D-03,
-     B    -2.09841352012720090D-03,    -5.73826764216626498D-03,
-     C    -7.70804244495414620D-03,    -8.21011692264844401D-03,
-     D    -7.65824520346905413D-03,    -6.47209729391045177D-03/
-      DATA BETA(191), BETA(192), BETA(193), BETA(194), BETA(195),
-     1     BETA(196), BETA(197), BETA(198), BETA(199), BETA(200),
-     2     BETA(201), BETA(202), BETA(203), BETA(204), BETA(205),
-     3     BETA(206), BETA(207), BETA(208), BETA(209), BETA(210)/
-     4    -4.99132412004966473D-03,    -3.45612289713133280D-03,
-     5    -2.01785580014170775D-03,    -7.59430686781961401D-04,
-     6     2.84173631523859138D-04,     1.10891667586337403D-03,
-     7     1.72901493872728771D-03,     2.16812590802684701D-03,
-     8     2.45357710494539735D-03,     2.61281821058334862D-03,
-     9     2.67141039656276912D-03,     2.65203073395980430D-03,
-     A     2.57411652877287315D-03,     2.45389126236094427D-03,
-     B     2.30460058071795494D-03,     2.13684837686712662D-03,
-     C     1.95896528478870911D-03,     1.77737008679454412D-03,
-     D     1.59690280765839059D-03,     1.42111975664438546D-03/
-      DATA GAMA(1), GAMA(2), GAMA(3), GAMA(4), GAMA(5), GAMA(6),
-     1     GAMA(7), GAMA(8), GAMA(9), GAMA(10), GAMA(11), GAMA(12),
-     2     GAMA(13), GAMA(14), GAMA(15), GAMA(16), GAMA(17), GAMA(18),
-     3     GAMA(19), GAMA(20), GAMA(21), GAMA(22)/
-     4     6.29960524947436582D-01,     2.51984209978974633D-01,
-     5     1.54790300415655846D-01,     1.10713062416159013D-01,
-     6     8.57309395527394825D-02,     6.97161316958684292D-02,
-     7     5.86085671893713576D-02,     5.04698873536310685D-02,
-     8     4.42600580689154809D-02,     3.93720661543509966D-02,
-     9     3.54283195924455368D-02,     3.21818857502098231D-02,
-     A     2.94646240791157679D-02,     2.71581677112934479D-02,
-     B     2.51768272973861779D-02,     2.34570755306078891D-02,
-     C     2.19508390134907203D-02,     2.06210828235646240D-02,
-     D     1.94388240897880846D-02,     1.83810633800683158D-02,
-     E     1.74293213231963172D-02,     1.65685837786612353D-02/
-      DATA GAMA(23), GAMA(24), GAMA(25), GAMA(26), GAMA(27), GAMA(28),
-     1     GAMA(29), GAMA(30)/
-     2     1.57865285987918445D-02,     1.50729501494095594D-02,
-     3     1.44193250839954639D-02,     1.38184805735341786D-02,
-     4     1.32643378994276568D-02,     1.27517121970498651D-02,
-     5     1.22761545318762767D-02,     1.18338262398482403D-02/
-      DATA EX1, EX2, HPI, GPI, THPI /
-     1     3.33333333333333333D-01,     6.66666666666666667D-01,
-     2     1.57079632679489662D+00,     3.14159265358979324D+00,
-     3     4.71238898038468986D+00/
-      DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 /
-C
-      RFNU = 1.0D0/FNU
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST (Z/FNU TOO SMALL)
-C-----------------------------------------------------------------------
-      TEST = D1MACH(1)*1.0D+3
-      AC = FNU*TEST
-      IF (DABS(ZR).GT.AC .OR. DABS(ZI).GT.AC) GO TO 15
-      ZETA1R = 2.0D0*DABS(DLOG(TEST))+FNU
-      ZETA1I = 0.0D0
-      ZETA2R = FNU
-      ZETA2I = 0.0D0
-      PHIR = 1.0D0
-      PHII = 0.0D0
-      ARGR = 1.0D0
-      ARGI = 0.0D0
-      RETURN
-   15 CONTINUE
-      ZBR = ZR*RFNU
-      ZBI = ZI*RFNU
-      RFNU2 = RFNU*RFNU
-C-----------------------------------------------------------------------
-C     COMPUTE IN THE FOURTH QUADRANT
-C-----------------------------------------------------------------------
-      FN13 = FNU**EX1
-      FN23 = FN13*FN13
-      RFN13 = 1.0D0/FN13
-      W2R = CONER - ZBR*ZBR + ZBI*ZBI
-      W2I = CONEI - ZBR*ZBI - ZBR*ZBI
-      AW2 = ZABS(COMPLEX(W2R,W2I))
-      IF (AW2.GT.0.25D0) GO TO 130
-C-----------------------------------------------------------------------
-C     POWER SERIES FOR CABS(W2).LE.0.25D0
-C-----------------------------------------------------------------------
-      K = 1
-      PR(1) = CONER
-      PI(1) = CONEI
-      SUMAR = GAMA(1)
-      SUMAI = ZEROI
-      AP(1) = 1.0D0
-      IF (AW2.LT.TOL) GO TO 20
-      DO 10 K=2,30
-        PR(K) = PR(K-1)*W2R - PI(K-1)*W2I
-        PI(K) = PR(K-1)*W2I + PI(K-1)*W2R
-        SUMAR = SUMAR + PR(K)*GAMA(K)
-        SUMAI = SUMAI + PI(K)*GAMA(K)
-        AP(K) = AP(K-1)*AW2
-        IF (AP(K).LT.TOL) GO TO 20
-   10 CONTINUE
-      K = 30
-   20 CONTINUE
-      KMAX = K
-      ZETAR = W2R*SUMAR - W2I*SUMAI
-      ZETAI = W2R*SUMAI + W2I*SUMAR
-      ARGR = ZETAR*FN23
-      ARGI = ZETAI*FN23
-      CALL ZSQRT(SUMAR, SUMAI, ZAR, ZAI)
-      CALL ZSQRT(W2R, W2I, STR, STI)
-      ZETA2R = STR*FNU
-      ZETA2I = STI*FNU
-      STR = CONER + EX2*(ZETAR*ZAR-ZETAI*ZAI)
-      STI = CONEI + EX2*(ZETAR*ZAI+ZETAI*ZAR)
-      ZETA1R = STR*ZETA2R - STI*ZETA2I
-      ZETA1I = STR*ZETA2I + STI*ZETA2R
-      ZAR = ZAR + ZAR
-      ZAI = ZAI + ZAI
-      CALL ZSQRT(ZAR, ZAI, STR, STI)
-      PHIR = STR*RFN13
-      PHII = STI*RFN13
-      IF (IPMTR.EQ.1) GO TO 120
-C-----------------------------------------------------------------------
-C     SUM SERIES FOR ASUM AND BSUM
-C-----------------------------------------------------------------------
-      SUMBR = ZEROR
-      SUMBI = ZEROI
-      DO 30 K=1,KMAX
-        SUMBR = SUMBR + PR(K)*BETA(K)
-        SUMBI = SUMBI + PI(K)*BETA(K)
-   30 CONTINUE
-      ASUMR = ZEROR
-      ASUMI = ZEROI
-      BSUMR = SUMBR
-      BSUMI = SUMBI
-      L1 = 0
-      L2 = 30
-      BTOL = TOL*(DABS(BSUMR)+DABS(BSUMI))
-      ATOL = TOL
-      PP = 1.0D0
-      IAS = 0
-      IBS = 0
-      IF (RFNU2.LT.TOL) GO TO 110
-      DO 100 IS=2,7
-        ATOL = ATOL/RFNU2
-        PP = PP*RFNU2
-        IF (IAS.EQ.1) GO TO 60
-        SUMAR = ZEROR
-        SUMAI = ZEROI
-        DO 40 K=1,KMAX
-          M = L1 + K
-          SUMAR = SUMAR + PR(K)*ALFA(M)
-          SUMAI = SUMAI + PI(K)*ALFA(M)
-          IF (AP(K).LT.ATOL) GO TO 50
-   40   CONTINUE
-   50   CONTINUE
-        ASUMR = ASUMR + SUMAR*PP
-        ASUMI = ASUMI + SUMAI*PP
-        IF (PP.LT.TOL) IAS = 1
-   60   CONTINUE
-        IF (IBS.EQ.1) GO TO 90
-        SUMBR = ZEROR
-        SUMBI = ZEROI
-        DO 70 K=1,KMAX
-          M = L2 + K
-          SUMBR = SUMBR + PR(K)*BETA(M)
-          SUMBI = SUMBI + PI(K)*BETA(M)
-          IF (AP(K).LT.ATOL) GO TO 80
-   70   CONTINUE
-   80   CONTINUE
-        BSUMR = BSUMR + SUMBR*PP
-        BSUMI = BSUMI + SUMBI*PP
-        IF (PP.LT.BTOL) IBS = 1
-   90   CONTINUE
-        IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 110
-        L1 = L1 + 30
-        L2 = L2 + 30
-  100 CONTINUE
-  110 CONTINUE
-      ASUMR = ASUMR + CONER
-      PP = RFNU*RFN13
-      BSUMR = BSUMR*PP
-      BSUMI = BSUMI*PP
-  120 CONTINUE
-      RETURN
-C-----------------------------------------------------------------------
-C     CABS(W2).GT.0.25D0
-C-----------------------------------------------------------------------
-  130 CONTINUE
-      CALL ZSQRT(W2R, W2I, WR, WI)
-      IF (WR.LT.0.0D0) WR = 0.0D0
-      IF (WI.LT.0.0D0) WI = 0.0D0
-      STR = CONER + WR
-      STI = WI
-      CALL ZDIV(STR, STI, ZBR, ZBI, ZAR, ZAI)
-      CALL ZLOG(ZAR, ZAI, ZCR, ZCI, IDUM)
-      IF (ZCI.LT.0.0D0) ZCI = 0.0D0
-      IF (ZCI.GT.HPI) ZCI = HPI
-      IF (ZCR.LT.0.0D0) ZCR = 0.0D0
-      ZTHR = (ZCR-WR)*1.5D0
-      ZTHI = (ZCI-WI)*1.5D0
-      ZETA1R = ZCR*FNU
-      ZETA1I = ZCI*FNU
-      ZETA2R = WR*FNU
-      ZETA2I = WI*FNU
-      AZTH = ZABS(COMPLEX(ZTHR,ZTHI))
-      ANG = THPI
-      IF (ZTHR.GE.0.0D0 .AND. ZTHI.LT.0.0D0) GO TO 140
-      ANG = HPI
-      IF (ZTHR.EQ.0.0D0) GO TO 140
-      ANG = DATAN(ZTHI/ZTHR)
-      IF (ZTHR.LT.0.0D0) ANG = ANG + GPI
-  140 CONTINUE
-      PP = AZTH**EX2
-      ANG = ANG*EX2
-      ZETAR = PP*DCOS(ANG)
-      ZETAI = PP*DSIN(ANG)
-      IF (ZETAI.LT.0.0D0) ZETAI = 0.0D0
-      ARGR = ZETAR*FN23
-      ARGI = ZETAI*FN23
-      CALL ZDIV(ZTHR, ZTHI, ZETAR, ZETAI, RTZTR, RTZTI)
-      CALL ZDIV(RTZTR, RTZTI, WR, WI, ZAR, ZAI)
-      TZAR = ZAR + ZAR
-      TZAI = ZAI + ZAI
-      CALL ZSQRT(TZAR, TZAI, STR, STI)
-      PHIR = STR*RFN13
-      PHII = STI*RFN13
-      IF (IPMTR.EQ.1) GO TO 120
-      RAW = 1.0D0/DSQRT(AW2)
-      STR = WR*RAW
-      STI = -WI*RAW
-      TFNR = STR*RFNU*RAW
-      TFNI = STI*RFNU*RAW
-      RAZTH = 1.0D0/AZTH
-      STR = ZTHR*RAZTH
-      STI = -ZTHI*RAZTH
-      RZTHR = STR*RAZTH*RFNU
-      RZTHI = STI*RAZTH*RFNU
-      ZCR = RZTHR*AR(2)
-      ZCI = RZTHI*AR(2)
-      RAW2 = 1.0D0/AW2
-      STR = W2R*RAW2
-      STI = -W2I*RAW2
-      T2R = STR*RAW2
-      T2I = STI*RAW2
-      STR = T2R*C(2) + C(3)
-      STI = T2I*C(2)
-      UPR(2) = STR*TFNR - STI*TFNI
-      UPI(2) = STR*TFNI + STI*TFNR
-      BSUMR = UPR(2) + ZCR
-      BSUMI = UPI(2) + ZCI
-      ASUMR = ZEROR
-      ASUMI = ZEROI
-      IF (RFNU.LT.TOL) GO TO 220
-      PRZTHR = RZTHR
-      PRZTHI = RZTHI
-      PTFNR = TFNR
-      PTFNI = TFNI
-      UPR(1) = CONER
-      UPI(1) = CONEI
-      PP = 1.0D0
-      BTOL = TOL*(DABS(BSUMR)+DABS(BSUMI))
-      KS = 0
-      KP1 = 2
-      L = 3
-      IAS = 0
-      IBS = 0
-      DO 210 LR=2,12,2
-        LRP1 = LR + 1
-C-----------------------------------------------------------------------
-C     COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN
-C     NEXT SUMA AND SUMB
-C-----------------------------------------------------------------------
-        DO 160 K=LR,LRP1
-          KS = KS + 1
-          KP1 = KP1 + 1
-          L = L + 1
-          ZAR = C(L)
-          ZAI = ZEROI
-          DO 150 J=2,KP1
-            L = L + 1
-            STR = ZAR*T2R - T2I*ZAI + C(L)
-            ZAI = ZAR*T2I + ZAI*T2R
-            ZAR = STR
-  150     CONTINUE
-          STR = PTFNR*TFNR - PTFNI*TFNI
-          PTFNI = PTFNR*TFNI + PTFNI*TFNR
-          PTFNR = STR
-          UPR(KP1) = PTFNR*ZAR - PTFNI*ZAI
-          UPI(KP1) = PTFNI*ZAR + PTFNR*ZAI
-          CRR(KS) = PRZTHR*BR(KS+1)
-          CRI(KS) = PRZTHI*BR(KS+1)
-          STR = PRZTHR*RZTHR - PRZTHI*RZTHI
-          PRZTHI = PRZTHR*RZTHI + PRZTHI*RZTHR
-          PRZTHR = STR
-          DRR(KS) = PRZTHR*AR(KS+2)
-          DRI(KS) = PRZTHI*AR(KS+2)
-  160   CONTINUE
-        PP = PP*RFNU2
-        IF (IAS.EQ.1) GO TO 180
-        SUMAR = UPR(LRP1)
-        SUMAI = UPI(LRP1)
-        JU = LRP1
-        DO 170 JR=1,LR
-          JU = JU - 1
-          SUMAR = SUMAR + CRR(JR)*UPR(JU) - CRI(JR)*UPI(JU)
-          SUMAI = SUMAI + CRR(JR)*UPI(JU) + CRI(JR)*UPR(JU)
-  170   CONTINUE
-        ASUMR = ASUMR + SUMAR
-        ASUMI = ASUMI + SUMAI
-        TEST = DABS(SUMAR) + DABS(SUMAI)
-        IF (PP.LT.TOL .AND. TEST.LT.TOL) IAS = 1
-  180   CONTINUE
-        IF (IBS.EQ.1) GO TO 200
-        SUMBR = UPR(LR+2) + UPR(LRP1)*ZCR - UPI(LRP1)*ZCI
-        SUMBI = UPI(LR+2) + UPR(LRP1)*ZCI + UPI(LRP1)*ZCR
-        JU = LRP1
-        DO 190 JR=1,LR
-          JU = JU - 1
-          SUMBR = SUMBR + DRR(JR)*UPR(JU) - DRI(JR)*UPI(JU)
-          SUMBI = SUMBI + DRR(JR)*UPI(JU) + DRI(JR)*UPR(JU)
-  190   CONTINUE
-        BSUMR = BSUMR + SUMBR
-        BSUMI = BSUMI + SUMBI
-        TEST = DABS(SUMBR) + DABS(SUMBI)
-        IF (PP.LT.BTOL .AND. TEST.LT.BTOL) IBS = 1
-  200   CONTINUE
-        IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 220
-  210 CONTINUE
-  220 CONTINUE
-      ASUMR = ASUMR + CONER
-      STR = -BSUMR*RFN13
-      STI = -BSUMI*RFN13
-      CALL ZDIV(STR, STI, RTZTR, RTZTI, BSUMR, BSUMI)
-      GO TO 120
-      END

amos/zuni1.f

@@ -1,204 +0,0 @@
-      SUBROUTINE ZUNI1(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL,
-     * TOL, ELIM, ALIM)
-C***BEGIN PROLOGUE  ZUNI1
-C***REFER TO  ZBESI,ZBESK
-C
-C     ZUNI1 COMPUTES I(FNU,Z)  BY MEANS OF THE UNIFORM ASYMPTOTIC
-C     EXPANSION FOR I(FNU,Z) IN -PI/3.LE.ARG Z.LE.PI/3.
-C
-C     FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC
-C     EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET.
-C     NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER
-C     FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL.
-C     Y(I)=CZERO FOR I=NLAST+1,N
-C
-C***ROUTINES CALLED  ZUCHK,ZUNIK,ZUOIK,D1MACH,ZABS
-C***END PROLOGUE  ZUNI1
-C     COMPLEX CFN,CONE,CRSC,CSCL,CSR,CSS,CWRK,CZERO,C1,C2,PHI,RZ,SUM,S1,
-C    *S2,Y,Z,ZETA1,ZETA2
-      DOUBLE PRECISION ALIM, APHI, ASCLE, BRY, CONER, CRSC,
-     * CSCL, CSRR, CSSR, CWRKI, CWRKR, C1R, C2I, C2M, C2R, ELIM, FN,
-     * FNU, FNUL, PHII, PHIR, RAST, RS1, RZI, RZR, STI, STR, SUMI,
-     * SUMR, S1I, S1R, S2I, S2R, TOL, YI, YR, ZEROI, ZEROR, ZETA1I,
-     * ZETA1R, ZETA2I, ZETA2R, ZI, ZR, CYR, CYI, D1MACH, ZABS
-      INTEGER I, IFLAG, INIT, K, KODE, M, N, ND, NLAST, NN, NUF, NW, NZ
-      DIMENSION BRY(3), YR(N), YI(N), CWRKR(16), CWRKI(16), CSSR(3),
-     * CSRR(3), CYR(2), CYI(2)
-      DATA ZEROR,ZEROI,CONER / 0.0D0, 0.0D0, 1.0D0 /
-C
-      NZ = 0
-      ND = N
-      NLAST = 0
-C-----------------------------------------------------------------------
-C     COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG-
-C     NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE,
-C     EXP(ALIM)=EXP(ELIM)*TOL
-C-----------------------------------------------------------------------
-      CSCL = 1.0D0/TOL
-      CRSC = TOL
-      CSSR(1) = CSCL
-      CSSR(2) = CONER
-      CSSR(3) = CRSC
-      CSRR(1) = CRSC
-      CSRR(2) = CONER
-      CSRR(3) = CSCL
-      BRY(1) = 1.0D+3*D1MACH(1)/TOL
-C-----------------------------------------------------------------------
-C     CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER
-C-----------------------------------------------------------------------
-      FN = DMAX1(FNU,1.0D0)
-      INIT = 0
-      CALL ZUNIK(ZR, ZI, FN, 1, 1, TOL, INIT, PHIR, PHII, ZETA1R,
-     * ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)
-      IF (KODE.EQ.1) GO TO 10
-      STR = ZR + ZETA2R
-      STI = ZI + ZETA2I
-      RAST = FN/ZABS(COMPLEX(STR,STI))
-      STR = STR*RAST*RAST
-      STI = -STI*RAST*RAST
-      S1R = -ZETA1R + STR
-      S1I = -ZETA1I + STI
-      GO TO 20
-   10 CONTINUE
-      S1R = -ZETA1R + ZETA2R
-      S1I = -ZETA1I + ZETA2I
-   20 CONTINUE
-      RS1 = S1R
-      IF (DABS(RS1).GT.ELIM) GO TO 130
-   30 CONTINUE
-      NN = MIN0(2,ND)
-      DO 80 I=1,NN
-        FN = FNU + DBLE(FLOAT(ND-I))
-        INIT = 0
-        CALL ZUNIK(ZR, ZI, FN, 1, 0, TOL, INIT, PHIR, PHII, ZETA1R,
-     *   ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)
-        IF (KODE.EQ.1) GO TO 40
-        STR = ZR + ZETA2R
-        STI = ZI + ZETA2I
-        RAST = FN/ZABS(COMPLEX(STR,STI))
-        STR = STR*RAST*RAST
-        STI = -STI*RAST*RAST
-        S1R = -ZETA1R + STR
-        S1I = -ZETA1I + STI + ZI
-        GO TO 50
-   40   CONTINUE
-        S1R = -ZETA1R + ZETA2R
-        S1I = -ZETA1I + ZETA2I
-   50   CONTINUE
-C-----------------------------------------------------------------------
-C     TEST FOR UNDERFLOW AND OVERFLOW
-C-----------------------------------------------------------------------
-        RS1 = S1R
-        IF (DABS(RS1).GT.ELIM) GO TO 110
-        IF (I.EQ.1) IFLAG = 2
-        IF (DABS(RS1).LT.ALIM) GO TO 60
-C-----------------------------------------------------------------------
-C     REFINE  TEST AND SCALE
-C-----------------------------------------------------------------------
-        APHI = ZABS(COMPLEX(PHIR,PHII))
-        RS1 = RS1 + DLOG(APHI)
-        IF (DABS(RS1).GT.ELIM) GO TO 110
-        IF (I.EQ.1) IFLAG = 1
-        IF (RS1.LT.0.0D0) GO TO 60
-        IF (I.EQ.1) IFLAG = 3
-   60   CONTINUE
-C-----------------------------------------------------------------------
-C     SCALE S1 IF CABS(S1).LT.ASCLE
-C-----------------------------------------------------------------------
-        S2R = PHIR*SUMR - PHII*SUMI
-        S2I = PHIR*SUMI + PHII*SUMR
-        STR = DEXP(S1R)*CSSR(IFLAG)
-        S1R = STR*DCOS(S1I)
-        S1I = STR*DSIN(S1I)
-        STR = S2R*S1R - S2I*S1I
-        S2I = S2R*S1I + S2I*S1R
-        S2R = STR
-        IF (IFLAG.NE.1) GO TO 70
-        CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL)
-        IF (NW.NE.0) GO TO 110
-   70   CONTINUE
-        CYR(I) = S2R
-        CYI(I) = S2I
-        M = ND - I + 1
-        YR(M) = S2R*CSRR(IFLAG)
-        YI(M) = S2I*CSRR(IFLAG)
-   80 CONTINUE
-      IF (ND.LE.2) GO TO 100
-      RAST = 1.0D0/ZABS(COMPLEX(ZR,ZI))
-      STR = ZR*RAST
-      STI = -ZI*RAST
-      RZR = (STR+STR)*RAST
-      RZI = (STI+STI)*RAST
-      BRY(2) = 1.0D0/BRY(1)
-      BRY(3) = D1MACH(2)
-      S1R = CYR(1)
-      S1I = CYI(1)
-      S2R = CYR(2)
-      S2I = CYI(2)
-      C1R = CSRR(IFLAG)
-      ASCLE = BRY(IFLAG)
-      K = ND - 2
-      FN = DBLE(FLOAT(K))
-      DO 90 I=3,ND
-        C2R = S2R
-        C2I = S2I
-        S2R = S1R + (FNU+FN)*(RZR*C2R-RZI*C2I)
-        S2I = S1I + (FNU+FN)*(RZR*C2I+RZI*C2R)
-        S1R = C2R
-        S1I = C2I
-        C2R = S2R*C1R
-        C2I = S2I*C1R
-        YR(K) = C2R
-        YI(K) = C2I
-        K = K - 1
-        FN = FN - 1.0D0
-        IF (IFLAG.GE.3) GO TO 90
-        STR = DABS(C2R)
-        STI = DABS(C2I)
-        C2M = DMAX1(STR,STI)
-        IF (C2M.LE.ASCLE) GO TO 90
-        IFLAG = IFLAG + 1
-        ASCLE = BRY(IFLAG)
-        S1R = S1R*C1R
-        S1I = S1I*C1R
-        S2R = C2R
-        S2I = C2I
-        S1R = S1R*CSSR(IFLAG)
-        S1I = S1I*CSSR(IFLAG)
-        S2R = S2R*CSSR(IFLAG)
-        S2I = S2I*CSSR(IFLAG)
-        C1R = CSRR(IFLAG)
-   90 CONTINUE
-  100 CONTINUE
-      RETURN
-C-----------------------------------------------------------------------
-C     SET UNDERFLOW AND UPDATE PARAMETERS
-C-----------------------------------------------------------------------
-  110 CONTINUE
-      IF (RS1.GT.0.0D0) GO TO 120
-      YR(ND) = ZEROR
-      YI(ND) = ZEROI
-      NZ = NZ + 1
-      ND = ND - 1
-      IF (ND.EQ.0) GO TO 100
-      CALL ZUOIK(ZR, ZI, FNU, KODE, 1, ND, YR, YI, NUF, TOL, ELIM, ALIM)
-      IF (NUF.LT.0) GO TO 120
-      ND = ND - NUF
-      NZ = NZ + NUF
-      IF (ND.EQ.0) GO TO 100
-      FN = FNU + DBLE(FLOAT(ND-1))
-      IF (FN.GE.FNUL) GO TO 30
-      NLAST = ND
-      RETURN
-  120 CONTINUE
-      NZ = -1
-      RETURN
-  130 CONTINUE
-      IF (RS1.GT.0.0D0) GO TO 120
-      NZ = N
-      DO 140 I=1,N
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-  140 CONTINUE
-      RETURN
-      END

amos/zuni2.f

@@ -1,267 +0,0 @@
-      SUBROUTINE ZUNI2(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL,
-     * TOL, ELIM, ALIM)
-C***BEGIN PROLOGUE  ZUNI2
-C***REFER TO  ZBESI,ZBESK
-C
-C     ZUNI2 COMPUTES I(FNU,Z) IN THE RIGHT HALF PLANE BY MEANS OF
-C     UNIFORM ASYMPTOTIC EXPANSION FOR J(FNU,ZN) WHERE ZN IS Z*I
-C     OR -Z*I AND ZN IS IN THE RIGHT HALF PLANE ALSO.
-C
-C     FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC
-C     EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET.
-C     NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER
-C     FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL.
-C     Y(I)=CZERO FOR I=NLAST+1,N
-C
-C***ROUTINES CALLED  ZAIRY,ZUCHK,ZUNHJ,ZUOIK,D1MACH,ZABS
-C***END PROLOGUE  ZUNI2
-C     COMPLEX AI,ARG,ASUM,BSUM,CFN,CI,CID,CIP,CONE,CRSC,CSCL,CSR,CSS,
-C    *CZERO,C1,C2,DAI,PHI,RZ,S1,S2,Y,Z,ZB,ZETA1,ZETA2,ZN
-      DOUBLE PRECISION AARG, AIC, AII, AIR, ALIM, ANG, APHI, ARGI,
-     * ARGR, ASCLE, ASUMI, ASUMR, BRY, BSUMI, BSUMR, CIDI, CIPI, CIPR,
-     * CONER, CRSC, CSCL, CSRR, CSSR, C1R, C2I, C2M, C2R, DAII,
-     * DAIR, ELIM, FN, FNU, FNUL, HPI, PHII, PHIR, RAST, RAZ, RS1, RZI,
-     * RZR, STI, STR, S1I, S1R, S2I, S2R, TOL, YI, YR, ZBI, ZBR, ZEROI,
-     * ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R, ZI, ZNI, ZNR, ZR, CYR,
-     * CYI, D1MACH, ZABS, CAR, SAR
-      INTEGER I, IFLAG, IN, INU, J, K, KODE, N, NAI, ND, NDAI, NLAST,
-     * NN, NUF, NW, NZ, IDUM
-      DIMENSION BRY(3), YR(N), YI(N), CIPR(4), CIPI(4), CSSR(3),
-     * CSRR(3), CYR(2), CYI(2)
-      DATA ZEROR,ZEROI,CONER / 0.0D0, 0.0D0, 1.0D0 /
-      DATA CIPR(1),CIPI(1),CIPR(2),CIPI(2),CIPR(3),CIPI(3),CIPR(4),
-     * CIPI(4)/ 1.0D0,0.0D0, 0.0D0,1.0D0, -1.0D0,0.0D0, 0.0D0,-1.0D0/
-      DATA HPI, AIC  /
-     1      1.57079632679489662D+00,     1.265512123484645396D+00/
-C
-      NZ = 0
-      ND = N
-      NLAST = 0
-C-----------------------------------------------------------------------
-C     COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG-
-C     NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE,
-C     EXP(ALIM)=EXP(ELIM)*TOL
-C-----------------------------------------------------------------------
-      CSCL = 1.0D0/TOL
-      CRSC = TOL
-      CSSR(1) = CSCL
-      CSSR(2) = CONER
-      CSSR(3) = CRSC
-      CSRR(1) = CRSC
-      CSRR(2) = CONER
-      CSRR(3) = CSCL
-      BRY(1) = 1.0D+3*D1MACH(1)/TOL
-C-----------------------------------------------------------------------
-C     ZN IS IN THE RIGHT HALF PLANE AFTER ROTATION BY CI OR -CI
-C-----------------------------------------------------------------------
-      ZNR = ZI
-      ZNI = -ZR
-      ZBR = ZR
-      ZBI = ZI
-      CIDI = -CONER
-      INU = INT(SNGL(FNU))
-      ANG = HPI*(FNU-DBLE(FLOAT(INU)))
-      C2R = DCOS(ANG)
-      C2I = DSIN(ANG)
-      CAR = C2R
-      SAR = C2I
-      IN = INU + N - 1
-      IN = MOD(IN,4) + 1
-      STR = C2R*CIPR(IN) - C2I*CIPI(IN)
-      C2I = C2R*CIPI(IN) + C2I*CIPR(IN)
-      C2R = STR
-      IF (ZI.GT.0.0D0) GO TO 10
-      ZNR = -ZNR
-      ZBI = -ZBI
-      CIDI = -CIDI
-      C2I = -C2I
-   10 CONTINUE
-C-----------------------------------------------------------------------
-C     CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER
-C-----------------------------------------------------------------------
-      FN = DMAX1(FNU,1.0D0)
-      CALL ZUNHJ(ZNR, ZNI, FN, 1, TOL, PHIR, PHII, ARGR, ARGI, ZETA1R,
-     * ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
-      IF (KODE.EQ.1) GO TO 20
-      STR = ZBR + ZETA2R
-      STI = ZBI + ZETA2I
-      RAST = FN/ZABS(COMPLEX(STR,STI))
-      STR = STR*RAST*RAST
-      STI = -STI*RAST*RAST
-      S1R = -ZETA1R + STR
-      S1I = -ZETA1I + STI
-      GO TO 30
-   20 CONTINUE
-      S1R = -ZETA1R + ZETA2R
-      S1I = -ZETA1I + ZETA2I
-   30 CONTINUE
-      RS1 = S1R
-      IF (DABS(RS1).GT.ELIM) GO TO 150
-   40 CONTINUE
-      NN = MIN0(2,ND)
-      DO 90 I=1,NN
-        FN = FNU + DBLE(FLOAT(ND-I))
-        CALL ZUNHJ(ZNR, ZNI, FN, 0, TOL, PHIR, PHII, ARGR, ARGI,
-     *   ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
-        IF (KODE.EQ.1) GO TO 50
-        STR = ZBR + ZETA2R
-        STI = ZBI + ZETA2I
-        RAST = FN/ZABS(COMPLEX(STR,STI))
-        STR = STR*RAST*RAST
-        STI = -STI*RAST*RAST
-        S1R = -ZETA1R + STR
-        S1I = -ZETA1I + STI + DABS(ZI)
-        GO TO 60
-   50   CONTINUE
-        S1R = -ZETA1R + ZETA2R
-        S1I = -ZETA1I + ZETA2I
-   60   CONTINUE
-C-----------------------------------------------------------------------
-C     TEST FOR UNDERFLOW AND OVERFLOW
-C-----------------------------------------------------------------------
-        RS1 = S1R
-        IF (DABS(RS1).GT.ELIM) GO TO 120
-        IF (I.EQ.1) IFLAG = 2
-        IF (DABS(RS1).LT.ALIM) GO TO 70
-C-----------------------------------------------------------------------
-C     REFINE  TEST AND SCALE
-C-----------------------------------------------------------------------
-C-----------------------------------------------------------------------
-        APHI = ZABS(COMPLEX(PHIR,PHII))
-        AARG = ZABS(COMPLEX(ARGR,ARGI))
-        RS1 = RS1 + DLOG(APHI) - 0.25D0*DLOG(AARG) - AIC
-        IF (DABS(RS1).GT.ELIM) GO TO 120
-        IF (I.EQ.1) IFLAG = 1
-        IF (RS1.LT.0.0D0) GO TO 70
-        IF (I.EQ.1) IFLAG = 3
-   70   CONTINUE
-C-----------------------------------------------------------------------
-C     SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR
-C     EXPONENT EXTREMES
-C-----------------------------------------------------------------------
-        CALL ZAIRY(ARGR, ARGI, 0, 2, AIR, AII, NAI, IDUM)
-        CALL ZAIRY(ARGR, ARGI, 1, 2, DAIR, DAII, NDAI, IDUM)
-        STR = DAIR*BSUMR - DAII*BSUMI
-        STI = DAIR*BSUMI + DAII*BSUMR
-        STR = STR + (AIR*ASUMR-AII*ASUMI)
-        STI = STI + (AIR*ASUMI+AII*ASUMR)
-        S2R = PHIR*STR - PHII*STI
-        S2I = PHIR*STI + PHII*STR
-        STR = DEXP(S1R)*CSSR(IFLAG)
-        S1R = STR*DCOS(S1I)
-        S1I = STR*DSIN(S1I)
-        STR = S2R*S1R - S2I*S1I
-        S2I = S2R*S1I + S2I*S1R
-        S2R = STR
-        IF (IFLAG.NE.1) GO TO 80
-        CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL)
-        IF (NW.NE.0) GO TO 120
-   80   CONTINUE
-        IF (ZI.LE.0.0D0) S2I = -S2I
-        STR = S2R*C2R - S2I*C2I
-        S2I = S2R*C2I + S2I*C2R
-        S2R = STR
-        CYR(I) = S2R
-        CYI(I) = S2I
-        J = ND - I + 1
-        YR(J) = S2R*CSRR(IFLAG)
-        YI(J) = S2I*CSRR(IFLAG)
-        STR = -C2I*CIDI
-        C2I = C2R*CIDI
-        C2R = STR
-   90 CONTINUE
-      IF (ND.LE.2) GO TO 110
-      RAZ = 1.0D0/ZABS(COMPLEX(ZR,ZI))
-      STR = ZR*RAZ
-      STI = -ZI*RAZ
-      RZR = (STR+STR)*RAZ
-      RZI = (STI+STI)*RAZ
-      BRY(2) = 1.0D0/BRY(1)
-      BRY(3) = D1MACH(2)
-      S1R = CYR(1)
-      S1I = CYI(1)
-      S2R = CYR(2)
-      S2I = CYI(2)
-      C1R = CSRR(IFLAG)
-      ASCLE = BRY(IFLAG)
-      K = ND - 2
-      FN = DBLE(FLOAT(K))
-      DO 100 I=3,ND
-        C2R = S2R
-        C2I = S2I
-        S2R = S1R + (FNU+FN)*(RZR*C2R-RZI*C2I)
-        S2I = S1I + (FNU+FN)*(RZR*C2I+RZI*C2R)
-        S1R = C2R
-        S1I = C2I
-        C2R = S2R*C1R
-        C2I = S2I*C1R
-        YR(K) = C2R
-        YI(K) = C2I
-        K = K - 1
-        FN = FN - 1.0D0
-        IF (IFLAG.GE.3) GO TO 100
-        STR = DABS(C2R)
-        STI = DABS(C2I)
-        C2M = DMAX1(STR,STI)
-        IF (C2M.LE.ASCLE) GO TO 100
-        IFLAG = IFLAG + 1
-        ASCLE = BRY(IFLAG)
-        S1R = S1R*C1R
-        S1I = S1I*C1R
-        S2R = C2R
-        S2I = C2I
-        S1R = S1R*CSSR(IFLAG)
-        S1I = S1I*CSSR(IFLAG)
-        S2R = S2R*CSSR(IFLAG)
-        S2I = S2I*CSSR(IFLAG)
-        C1R = CSRR(IFLAG)
-  100 CONTINUE
-  110 CONTINUE
-      RETURN
-  120 CONTINUE
-      IF (RS1.GT.0.0D0) GO TO 140
-C-----------------------------------------------------------------------
-C     SET UNDERFLOW AND UPDATE PARAMETERS
-C-----------------------------------------------------------------------
-      YR(ND) = ZEROR
-      YI(ND) = ZEROI
-      NZ = NZ + 1
-      ND = ND - 1
-      IF (ND.EQ.0) GO TO 110
-      CALL ZUOIK(ZR, ZI, FNU, KODE, 1, ND, YR, YI, NUF, TOL, ELIM, ALIM)
-      IF (NUF.LT.0) GO TO 140
-      ND = ND - NUF
-      NZ = NZ + NUF
-      IF (ND.EQ.0) GO TO 110
-      FN = FNU + DBLE(FLOAT(ND-1))
-      IF (FN.LT.FNUL) GO TO 130
-C      FN = CIDI
-C      J = NUF + 1
-C      K = MOD(J,4) + 1
-C      S1R = CIPR(K)
-C      S1I = CIPI(K)
-C      IF (FN.LT.0.0D0) S1I = -S1I
-C      STR = C2R*S1R - C2I*S1I
-C      C2I = C2R*S1I + C2I*S1R
-C      C2R = STR
-      IN = INU + ND - 1
-      IN = MOD(IN,4) + 1
-      C2R = CAR*CIPR(IN) - SAR*CIPI(IN)
-      C2I = CAR*CIPI(IN) + SAR*CIPR(IN)
-      IF (ZI.LE.0.0D0) C2I = -C2I
-      GO TO 40
-  130 CONTINUE
-      NLAST = ND
-      RETURN
-  140 CONTINUE
-      NZ = -1
-      RETURN
-  150 CONTINUE
-      IF (RS1.GT.0.0D0) GO TO 140
-      NZ = N
-      DO 160 I=1,N
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-  160 CONTINUE
-      RETURN
-      END

amos/zunik.f

@@ -1,211 +0,0 @@
-      SUBROUTINE ZUNIK(ZRR, ZRI, FNU, IKFLG, IPMTR, TOL, INIT, PHIR,
-     * PHII, ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)
-C***BEGIN PROLOGUE  ZUNIK
-C***REFER TO  ZBESI,ZBESK
-C
-C        ZUNIK COMPUTES PARAMETERS FOR THE UNIFORM ASYMPTOTIC
-C        EXPANSIONS OF THE I AND K FUNCTIONS ON IKFLG= 1 OR 2
-C        RESPECTIVELY BY
-C
-C        W(FNU,ZR) = PHI*EXP(ZETA)*SUM
-C
-C        WHERE       ZETA=-ZETA1 + ZETA2       OR
-C                          ZETA1 - ZETA2
-C
-C        THE FIRST CALL MUST HAVE INIT=0. SUBSEQUENT CALLS WITH THE
-C        SAME ZR AND FNU WILL RETURN THE I OR K FUNCTION ON IKFLG=
-C        1 OR 2 WITH NO CHANGE IN INIT. CWRK IS A COMPLEX WORK
-C        ARRAY. IPMTR=0 COMPUTES ALL PARAMETERS. IPMTR=1 COMPUTES PHI,
-C        ZETA1,ZETA2.
-C
-C***ROUTINES CALLED  ZDIV,ZLOG,ZSQRT,D1MACH
-C***END PROLOGUE  ZUNIK
-C     COMPLEX CFN,CON,CONE,CRFN,CWRK,CZERO,PHI,S,SR,SUM,T,T2,ZETA1,
-C    *ZETA2,ZN,ZR
-      DOUBLE PRECISION AC, C, CON, CONEI, CONER, CRFNI, CRFNR, CWRKI,
-     * CWRKR, FNU, PHII, PHIR, RFN, SI, SR, SRI, SRR, STI, STR, SUMI,
-     * SUMR, TEST, TI, TOL, TR, T2I, T2R, ZEROI, ZEROR, ZETA1I, ZETA1R,
-     * ZETA2I, ZETA2R, ZNI, ZNR, ZRI, ZRR, D1MACH
-      INTEGER I, IDUM, IKFLG, INIT, IPMTR, J, K, L
-      DIMENSION C(120), CWRKR(16), CWRKI(16), CON(2)
-      DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 /
-      DATA CON(1), CON(2)  /
-     1 3.98942280401432678D-01,  1.25331413731550025D+00 /
-      DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10),
-     1     C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18),
-     2     C(19), C(20), C(21), C(22), C(23), C(24)/
-     3     1.00000000000000000D+00,    -2.08333333333333333D-01,
-     4     1.25000000000000000D-01,     3.34201388888888889D-01,
-     5    -4.01041666666666667D-01,     7.03125000000000000D-02,
-     6    -1.02581259645061728D+00,     1.84646267361111111D+00,
-     7    -8.91210937500000000D-01,     7.32421875000000000D-02,
-     8     4.66958442342624743D+00,    -1.12070026162229938D+01,
-     9     8.78912353515625000D+00,    -2.36408691406250000D+00,
-     A     1.12152099609375000D-01,    -2.82120725582002449D+01,
-     B     8.46362176746007346D+01,    -9.18182415432400174D+01,
-     C     4.25349987453884549D+01,    -7.36879435947963170D+00,
-     D     2.27108001708984375D-01,     2.12570130039217123D+02,
-     E    -7.65252468141181642D+02,     1.05999045252799988D+03/
-      DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32),
-     1     C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40),
-     2     C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/
-     3    -6.99579627376132541D+02,     2.18190511744211590D+02,
-     4    -2.64914304869515555D+01,     5.72501420974731445D-01,
-     5    -1.91945766231840700D+03,     8.06172218173730938D+03,
-     6    -1.35865500064341374D+04,     1.16553933368645332D+04,
-     7    -5.30564697861340311D+03,     1.20090291321635246D+03,
-     8    -1.08090919788394656D+02,     1.72772750258445740D+00,
-     9     2.02042913309661486D+04,    -9.69805983886375135D+04,
-     A     1.92547001232531532D+05,    -2.03400177280415534D+05,
-     B     1.22200464983017460D+05,    -4.11926549688975513D+04,
-     C     7.10951430248936372D+03,    -4.93915304773088012D+02,
-     D     6.07404200127348304D+00,    -2.42919187900551333D+05,
-     E     1.31176361466297720D+06,    -2.99801591853810675D+06/
-      DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56),
-     1     C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64),
-     2     C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/
-     3     3.76327129765640400D+06,    -2.81356322658653411D+06,
-     4     1.26836527332162478D+06,    -3.31645172484563578D+05,
-     5     4.52187689813627263D+04,    -2.49983048181120962D+03,
-     6     2.43805296995560639D+01,     3.28446985307203782D+06,
-     7    -1.97068191184322269D+07,     5.09526024926646422D+07,
-     8    -7.41051482115326577D+07,     6.63445122747290267D+07,
-     9    -3.75671766607633513D+07,     1.32887671664218183D+07,
-     A    -2.78561812808645469D+06,     3.08186404612662398D+05,
-     B    -1.38860897537170405D+04,     1.10017140269246738D+02,
-     C    -4.93292536645099620D+07,     3.25573074185765749D+08,
-     D    -9.39462359681578403D+08,     1.55359689957058006D+09,
-     E    -1.62108055210833708D+09,     1.10684281682301447D+09/
-      DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80),
-     1     C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88),
-     2     C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/
-     3    -4.95889784275030309D+08,     1.42062907797533095D+08,
-     4    -2.44740627257387285D+07,     2.24376817792244943D+06,
-     5    -8.40054336030240853D+04,     5.51335896122020586D+02,
-     6     8.14789096118312115D+08,    -5.86648149205184723D+09,
-     7     1.86882075092958249D+10,    -3.46320433881587779D+10,
-     8     4.12801855797539740D+10,    -3.30265997498007231D+10,
-     9     1.79542137311556001D+10,    -6.56329379261928433D+09,
-     A     1.55927986487925751D+09,    -2.25105661889415278D+08,
-     B     1.73951075539781645D+07,    -5.49842327572288687D+05,
-     C     3.03809051092238427D+03,    -1.46792612476956167D+10,
-     D     1.14498237732025810D+11,    -3.99096175224466498D+11,
-     E     8.19218669548577329D+11,    -1.09837515608122331D+12/
-      DATA C(97), C(98), C(99), C(100), C(101), C(102), C(103), C(104),
-     1     C(105), C(106), C(107), C(108), C(109), C(110), C(111),
-     2     C(112), C(113), C(114), C(115), C(116), C(117), C(118)/
-     3     1.00815810686538209D+12,    -6.45364869245376503D+11,
-     4     2.87900649906150589D+11,    -8.78670721780232657D+10,
-     5     1.76347306068349694D+10,    -2.16716498322379509D+09,
-     6     1.43157876718888981D+08,    -3.87183344257261262D+06,
-     7     1.82577554742931747D+04,     2.86464035717679043D+11,
-     8    -2.40629790002850396D+12,     9.10934118523989896D+12,
-     9    -2.05168994109344374D+13,     3.05651255199353206D+13,
-     A    -3.16670885847851584D+13,     2.33483640445818409D+13,
-     B    -1.23204913055982872D+13,     4.61272578084913197D+12,
-     C    -1.19655288019618160D+12,     2.05914503232410016D+11,
-     D    -2.18229277575292237D+10,     1.24700929351271032D+09/
-      DATA C(119), C(120)/
-     1    -2.91883881222208134D+07,     1.18838426256783253D+05/
-C
-      IF (INIT.NE.0) GO TO 40
-C-----------------------------------------------------------------------
-C     INITIALIZE ALL VARIABLES
-C-----------------------------------------------------------------------
-      RFN = 1.0D0/FNU
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST (ZR/FNU TOO SMALL)
-C-----------------------------------------------------------------------
-      TEST = D1MACH(1)*1.0D+3
-      AC = FNU*TEST
-      IF (DABS(ZRR).GT.AC .OR. DABS(ZRI).GT.AC) GO TO 15
-      ZETA1R = 2.0D0*DABS(DLOG(TEST))+FNU
-      ZETA1I = 0.0D0
-      ZETA2R = FNU
-      ZETA2I = 0.0D0
-      PHIR = 1.0D0
-      PHII = 0.0D0
-      RETURN
-   15 CONTINUE
-      TR = ZRR*RFN
-      TI = ZRI*RFN
-      SR = CONER + (TR*TR-TI*TI)
-      SI = CONEI + (TR*TI+TI*TR)
-      CALL ZSQRT(SR, SI, SRR, SRI)
-      STR = CONER + SRR
-      STI = CONEI + SRI
-      CALL ZDIV(STR, STI, TR, TI, ZNR, ZNI)
-      CALL ZLOG(ZNR, ZNI, STR, STI, IDUM)
-      ZETA1R = FNU*STR
-      ZETA1I = FNU*STI
-      ZETA2R = FNU*SRR
-      ZETA2I = FNU*SRI
-      CALL ZDIV(CONER, CONEI, SRR, SRI, TR, TI)
-      SRR = TR*RFN
-      SRI = TI*RFN
-      CALL ZSQRT(SRR, SRI, CWRKR(16), CWRKI(16))
-      PHIR = CWRKR(16)*CON(IKFLG)
-      PHII = CWRKI(16)*CON(IKFLG)
-      IF (IPMTR.NE.0) RETURN
-      CALL ZDIV(CONER, CONEI, SR, SI, T2R, T2I)
-      CWRKR(1) = CONER
-      CWRKI(1) = CONEI
-      CRFNR = CONER
-      CRFNI = CONEI
-      AC = 1.0D0
-      L = 1
-      DO 20 K=2,15
-        SR = ZEROR
-        SI = ZEROI
-        DO 10 J=1,K
-          L = L + 1
-          STR = SR*T2R - SI*T2I + C(L)
-          SI = SR*T2I + SI*T2R
-          SR = STR
-   10   CONTINUE
-        STR = CRFNR*SRR - CRFNI*SRI
-        CRFNI = CRFNR*SRI + CRFNI*SRR
-        CRFNR = STR
-        CWRKR(K) = CRFNR*SR - CRFNI*SI
-        CWRKI(K) = CRFNR*SI + CRFNI*SR
-        AC = AC*RFN
-        TEST = DABS(CWRKR(K)) + DABS(CWRKI(K))
-        IF (AC.LT.TOL .AND. TEST.LT.TOL) GO TO 30
-   20 CONTINUE
-      K = 15
-   30 CONTINUE
-      INIT = K
-   40 CONTINUE
-      IF (IKFLG.EQ.2) GO TO 60
-C-----------------------------------------------------------------------
-C     COMPUTE SUM FOR THE I FUNCTION
-C-----------------------------------------------------------------------
-      SR = ZEROR
-      SI = ZEROI
-      DO 50 I=1,INIT
-        SR = SR + CWRKR(I)
-        SI = SI + CWRKI(I)
-   50 CONTINUE
-      SUMR = SR
-      SUMI = SI
-      PHIR = CWRKR(16)*CON(1)
-      PHII = CWRKI(16)*CON(1)
-      RETURN
-   60 CONTINUE
-C-----------------------------------------------------------------------
-C     COMPUTE SUM FOR THE K FUNCTION
-C-----------------------------------------------------------------------
-      SR = ZEROR
-      SI = ZEROI
-      TR = CONER
-      DO 70 I=1,INIT
-        SR = SR + TR*CWRKR(I)
-        SI = SI + TR*CWRKI(I)
-        TR = -TR
-   70 CONTINUE
-      SUMR = SR
-      SUMI = SI
-      PHIR = CWRKR(16)*CON(2)
-      PHII = CWRKI(16)*CON(2)
-      RETURN
-      END

amos/zunk1.f

@@ -1,426 +0,0 @@
-      SUBROUTINE ZUNK1(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM,
-     * ALIM)
-C***BEGIN PROLOGUE  ZUNK1
-C***REFER TO  ZBESK
-C
-C     ZUNK1 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE
-C     RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE
-C     UNIFORM ASYMPTOTIC EXPANSION.
-C     MR INDICATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION.
-C     NZ=-1 MEANS AN OVERFLOW WILL OCCUR
-C
-C***ROUTINES CALLED  ZKSCL,ZS1S2,ZUCHK,ZUNIK,D1MACH,ZABS
-C***END PROLOGUE  ZUNK1
-C     COMPLEX CFN,CK,CONE,CRSC,CS,CSCL,CSGN,CSPN,CSR,CSS,CWRK,CY,CZERO,
-C    *C1,C2,PHI,PHID,RZ,SUM,SUMD,S1,S2,Y,Z,ZETA1,ZETA1D,ZETA2,ZETA2D,ZR
-      DOUBLE PRECISION ALIM, ANG, APHI, ASC, ASCLE, BRY, CKI, CKR,
-     * CONER, CRSC, CSCL, CSGNI, CSPNI, CSPNR, CSR, CSRR, CSSR,
-     * CWRKI, CWRKR, CYI, CYR, C1I, C1R, C2I, C2M, C2R, ELIM, FMR, FN,
-     * FNF, FNU, PHIDI, PHIDR, PHII, PHIR, PI, RAST, RAZR, RS1, RZI,
-     * RZR, SGN, STI, STR, SUMDI, SUMDR, SUMI, SUMR, S1I, S1R, S2I,
-     * S2R, TOL, YI, YR, ZEROI, ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R,
-     * ZET1DI, ZET1DR, ZET2DI, ZET2DR, ZI, ZR, ZRI, ZRR, D1MACH, ZABS
-      INTEGER I, IB, IFLAG, IFN, IL, INIT, INU, IUF, K, KDFLG, KFLAG,
-     * KK, KODE, MR, N, NW, NZ, INITD, IC, IPARD, J
-      DIMENSION BRY(3), INIT(2), YR(N), YI(N), SUMR(2), SUMI(2),
-     * ZETA1R(2), ZETA1I(2), ZETA2R(2), ZETA2I(2), CYR(2), CYI(2),
-     * CWRKR(16,3), CWRKI(16,3), CSSR(3), CSRR(3), PHIR(2), PHII(2)
-      DATA ZEROR,ZEROI,CONER / 0.0D0, 0.0D0, 1.0D0 /
-      DATA PI / 3.14159265358979324D0 /
-C
-      KDFLG = 1
-      NZ = 0
-C-----------------------------------------------------------------------
-C     EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN
-C     THE UNDERFLOW LIMIT
-C-----------------------------------------------------------------------
-      CSCL = 1.0D0/TOL
-      CRSC = TOL
-      CSSR(1) = CSCL
-      CSSR(2) = CONER
-      CSSR(3) = CRSC
-      CSRR(1) = CRSC
-      CSRR(2) = CONER
-      CSRR(3) = CSCL
-      BRY(1) = 1.0D+3*D1MACH(1)/TOL
-      BRY(2) = 1.0D0/BRY(1)
-      BRY(3) = D1MACH(2)
-      ZRR = ZR
-      ZRI = ZI
-      IF (ZR.GE.0.0D0) GO TO 10
-      ZRR = -ZR
-      ZRI = -ZI
-   10 CONTINUE
-      J = 2
-      DO 70 I=1,N
-C-----------------------------------------------------------------------
-C     J FLIP FLOPS BETWEEN 1 AND 2 IN J = 3 - J
-C-----------------------------------------------------------------------
-        J = 3 - J
-        FN = FNU + DBLE(FLOAT(I-1))
-        INIT(J) = 0
-        CALL ZUNIK(ZRR, ZRI, FN, 2, 0, TOL, INIT(J), PHIR(J), PHII(J),
-     *   ZETA1R(J), ZETA1I(J), ZETA2R(J), ZETA2I(J), SUMR(J), SUMI(J),
-     *   CWRKR(1,J), CWRKI(1,J))
-        IF (KODE.EQ.1) GO TO 20
-        STR = ZRR + ZETA2R(J)
-        STI = ZRI + ZETA2I(J)
-        RAST = FN/ZABS(COMPLEX(STR,STI))
-        STR = STR*RAST*RAST
-        STI = -STI*RAST*RAST
-        S1R = ZETA1R(J) - STR
-        S1I = ZETA1I(J) - STI
-        GO TO 30
-   20   CONTINUE
-        S1R = ZETA1R(J) - ZETA2R(J)
-        S1I = ZETA1I(J) - ZETA2I(J)
-   30   CONTINUE
-        RS1 = S1R
-C-----------------------------------------------------------------------
-C     TEST FOR UNDERFLOW AND OVERFLOW
-C-----------------------------------------------------------------------
-        IF (DABS(RS1).GT.ELIM) GO TO 60
-        IF (KDFLG.EQ.1) KFLAG = 2
-        IF (DABS(RS1).LT.ALIM) GO TO 40
-C-----------------------------------------------------------------------
-C     REFINE  TEST AND SCALE
-C-----------------------------------------------------------------------
-        APHI = ZABS(COMPLEX(PHIR(J),PHII(J)))
-        RS1 = RS1 + DLOG(APHI)
-        IF (DABS(RS1).GT.ELIM) GO TO 60
-        IF (KDFLG.EQ.1) KFLAG = 1
-        IF (RS1.LT.0.0D0) GO TO 40
-        IF (KDFLG.EQ.1) KFLAG = 3
-   40   CONTINUE
-C-----------------------------------------------------------------------
-C     SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR
-C     EXPONENT EXTREMES
-C-----------------------------------------------------------------------
-        S2R = PHIR(J)*SUMR(J) - PHII(J)*SUMI(J)
-        S2I = PHIR(J)*SUMI(J) + PHII(J)*SUMR(J)
-        STR = DEXP(S1R)*CSSR(KFLAG)
-        S1R = STR*DCOS(S1I)
-        S1I = STR*DSIN(S1I)
-        STR = S2R*S1R - S2I*S1I
-        S2I = S1R*S2I + S2R*S1I
-        S2R = STR
-        IF (KFLAG.NE.1) GO TO 50
-        CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL)
-        IF (NW.NE.0) GO TO 60
-   50   CONTINUE
-        CYR(KDFLG) = S2R
-        CYI(KDFLG) = S2I
-        YR(I) = S2R*CSRR(KFLAG)
-        YI(I) = S2I*CSRR(KFLAG)
-        IF (KDFLG.EQ.2) GO TO 75
-        KDFLG = 2
-        GO TO 70
-   60   CONTINUE
-        IF (RS1.GT.0.0D0) GO TO 300
-C-----------------------------------------------------------------------
-C     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW
-C-----------------------------------------------------------------------
-        IF (ZR.LT.0.0D0) GO TO 300
-        KDFLG = 1
-        YR(I)=ZEROR
-        YI(I)=ZEROI
-        NZ=NZ+1
-        IF (I.EQ.1) GO TO 70
-        IF ((YR(I-1).EQ.ZEROR).AND.(YI(I-1).EQ.ZEROI)) GO TO 70
-        YR(I-1)=ZEROR
-        YI(I-1)=ZEROI
-        NZ=NZ+1
-   70 CONTINUE
-      I = N
-   75 CONTINUE
-      RAZR = 1.0D0/ZABS(COMPLEX(ZRR,ZRI))
-      STR = ZRR*RAZR
-      STI = -ZRI*RAZR
-      RZR = (STR+STR)*RAZR
-      RZI = (STI+STI)*RAZR
-      CKR = FN*RZR
-      CKI = FN*RZI
-      IB = I + 1
-      IF (N.LT.IB) GO TO 160
-C-----------------------------------------------------------------------
-C     TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW. SET SEQUENCE TO ZERO
-C     ON UNDERFLOW.
-C-----------------------------------------------------------------------
-      FN = FNU + DBLE(FLOAT(N-1))
-      IPARD = 1
-      IF (MR.NE.0) IPARD = 0
-      INITD = 0
-      CALL ZUNIK(ZRR, ZRI, FN, 2, IPARD, TOL, INITD, PHIDR, PHIDI,
-     * ZET1DR, ZET1DI, ZET2DR, ZET2DI, SUMDR, SUMDI, CWRKR(1,3),
-     * CWRKI(1,3))
-      IF (KODE.EQ.1) GO TO 80
-      STR = ZRR + ZET2DR
-      STI = ZRI + ZET2DI
-      RAST = FN/ZABS(COMPLEX(STR,STI))
-      STR = STR*RAST*RAST
-      STI = -STI*RAST*RAST
-      S1R = ZET1DR - STR
-      S1I = ZET1DI - STI
-      GO TO 90
-   80 CONTINUE
-      S1R = ZET1DR - ZET2DR
-      S1I = ZET1DI - ZET2DI
-   90 CONTINUE
-      RS1 = S1R
-      IF (DABS(RS1).GT.ELIM) GO TO 95
-      IF (DABS(RS1).LT.ALIM) GO TO 100
-C----------------------------------------------------------------------------
-C     REFINE ESTIMATE AND TEST
-C-------------------------------------------------------------------------
-      APHI = ZABS(COMPLEX(PHIDR,PHIDI))
-      RS1 = RS1+DLOG(APHI)
-      IF (DABS(RS1).LT.ELIM) GO TO 100
-   95 CONTINUE
-      IF (DABS(RS1).GT.0.0D0) GO TO 300
-C-----------------------------------------------------------------------
-C     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW
-C-----------------------------------------------------------------------
-      IF (ZR.LT.0.0D0) GO TO 300
-      NZ = N
-      DO 96 I=1,N
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-   96 CONTINUE
-      RETURN
-C---------------------------------------------------------------------------
-C     FORWARD RECUR FOR REMAINDER OF THE SEQUENCE
-C----------------------------------------------------------------------------
-  100 CONTINUE
-      S1R = CYR(1)
-      S1I = CYI(1)
-      S2R = CYR(2)
-      S2I = CYI(2)
-      C1R = CSRR(KFLAG)
-      ASCLE = BRY(KFLAG)
-      DO 120 I=IB,N
-        C2R = S2R
-        C2I = S2I
-        S2R = CKR*C2R - CKI*C2I + S1R
-        S2I = CKR*C2I + CKI*C2R + S1I
-        S1R = C2R
-        S1I = C2I
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        C2R = S2R*C1R
-        C2I = S2I*C1R
-        YR(I) = C2R
-        YI(I) = C2I
-        IF (KFLAG.GE.3) GO TO 120
-        STR = DABS(C2R)
-        STI = DABS(C2I)
-        C2M = DMAX1(STR,STI)
-        IF (C2M.LE.ASCLE) GO TO 120
-        KFLAG = KFLAG + 1
-        ASCLE = BRY(KFLAG)
-        S1R = S1R*C1R
-        S1I = S1I*C1R
-        S2R = C2R
-        S2I = C2I
-        S1R = S1R*CSSR(KFLAG)
-        S1I = S1I*CSSR(KFLAG)
-        S2R = S2R*CSSR(KFLAG)
-        S2I = S2I*CSSR(KFLAG)
-        C1R = CSRR(KFLAG)
-  120 CONTINUE
-  160 CONTINUE
-      IF (MR.EQ.0) RETURN
-C-----------------------------------------------------------------------
-C     ANALYTIC CONTINUATION FOR RE(Z).LT.0.0D0
-C-----------------------------------------------------------------------
-      NZ = 0
-      FMR = DBLE(FLOAT(MR))
-      SGN = -DSIGN(PI,FMR)
-C-----------------------------------------------------------------------
-C     CSPN AND CSGN ARE COEFF OF K AND I FUNCTIONS RESP.
-C-----------------------------------------------------------------------
-      CSGNI = SGN
-      INU = INT(SNGL(FNU))
-      FNF = FNU - DBLE(FLOAT(INU))
-      IFN = INU + N - 1
-      ANG = FNF*SGN
-      CSPNR = DCOS(ANG)
-      CSPNI = DSIN(ANG)
-      IF (MOD(IFN,2).EQ.0) GO TO 170
-      CSPNR = -CSPNR
-      CSPNI = -CSPNI
-  170 CONTINUE
-      ASC = BRY(1)
-      IUF = 0
-      KK = N
-      KDFLG = 1
-      IB = IB - 1
-      IC = IB - 1
-      DO 270 K=1,N
-        FN = FNU + DBLE(FLOAT(KK-1))
-C-----------------------------------------------------------------------
-C     LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K
-C     FUNCTION ABOVE
-C-----------------------------------------------------------------------
-        M=3
-        IF (N.GT.2) GO TO 175
-  172   CONTINUE
-        INITD = INIT(J)
-        PHIDR = PHIR(J)
-        PHIDI = PHII(J)
-        ZET1DR = ZETA1R(J)
-        ZET1DI = ZETA1I(J)
-        ZET2DR = ZETA2R(J)
-        ZET2DI = ZETA2I(J)
-        SUMDR = SUMR(J)
-        SUMDI = SUMI(J)
-        M = J
-        J = 3 - J
-        GO TO 180
-  175   CONTINUE
-        IF ((KK.EQ.N).AND.(IB.LT.N)) GO TO 180
-        IF ((KK.EQ.IB).OR.(KK.EQ.IC)) GO TO 172
-        INITD = 0
-  180   CONTINUE
-        CALL ZUNIK(ZRR, ZRI, FN, 1, 0, TOL, INITD, PHIDR, PHIDI,
-     *   ZET1DR, ZET1DI, ZET2DR, ZET2DI, SUMDR, SUMDI,
-     *   CWRKR(1,M), CWRKI(1,M))
-        IF (KODE.EQ.1) GO TO 200
-        STR = ZRR + ZET2DR
-        STI = ZRI + ZET2DI
-        RAST = FN/ZABS(COMPLEX(STR,STI))
-        STR = STR*RAST*RAST
-        STI = -STI*RAST*RAST
-        S1R = -ZET1DR + STR
-        S1I = -ZET1DI + STI
-        GO TO 210
-  200   CONTINUE
-        S1R = -ZET1DR + ZET2DR
-        S1I = -ZET1DI + ZET2DI
-  210   CONTINUE
-C-----------------------------------------------------------------------
-C     TEST FOR UNDERFLOW AND OVERFLOW
-C-----------------------------------------------------------------------
-        RS1 = S1R
-        IF (DABS(RS1).GT.ELIM) GO TO 260
-        IF (KDFLG.EQ.1) IFLAG = 2
-        IF (DABS(RS1).LT.ALIM) GO TO 220
-C-----------------------------------------------------------------------
-C     REFINE  TEST AND SCALE
-C-----------------------------------------------------------------------
-        APHI = ZABS(COMPLEX(PHIDR,PHIDI))
-        RS1 = RS1 + DLOG(APHI)
-        IF (DABS(RS1).GT.ELIM) GO TO 260
-        IF (KDFLG.EQ.1) IFLAG = 1
-        IF (RS1.LT.0.0D0) GO TO 220
-        IF (KDFLG.EQ.1) IFLAG = 3
-  220   CONTINUE
-        STR = PHIDR*SUMDR - PHIDI*SUMDI
-        STI = PHIDR*SUMDI + PHIDI*SUMDR
-        S2R = -CSGNI*STI
-        S2I = CSGNI*STR
-        STR = DEXP(S1R)*CSSR(IFLAG)
-        S1R = STR*DCOS(S1I)
-        S1I = STR*DSIN(S1I)
-        STR = S2R*S1R - S2I*S1I
-        S2I = S2R*S1I + S2I*S1R
-        S2R = STR
-        IF (IFLAG.NE.1) GO TO 230
-        CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL)
-        IF (NW.EQ.0) GO TO 230
-        S2R = ZEROR
-        S2I = ZEROI
-  230   CONTINUE
-        CYR(KDFLG) = S2R
-        CYI(KDFLG) = S2I
-        C2R = S2R
-        C2I = S2I
-        S2R = S2R*CSRR(IFLAG)
-        S2I = S2I*CSRR(IFLAG)
-C-----------------------------------------------------------------------
-C     ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N
-C-----------------------------------------------------------------------
-        S1R = YR(KK)
-        S1I = YI(KK)
-        IF (KODE.EQ.1) GO TO 250
-        CALL ZS1S2(ZRR, ZRI, S1R, S1I, S2R, S2I, NW, ASC, ALIM, IUF)
-        NZ = NZ + NW
-  250   CONTINUE
-        YR(KK) = S1R*CSPNR - S1I*CSPNI + S2R
-        YI(KK) = CSPNR*S1I + CSPNI*S1R + S2I
-        KK = KK - 1
-        CSPNR = -CSPNR
-        CSPNI = -CSPNI
-        IF (C2R.NE.0.0D0 .OR. C2I.NE.0.0D0) GO TO 255
-        KDFLG = 1
-        GO TO 270
-  255   CONTINUE
-        IF (KDFLG.EQ.2) GO TO 275
-        KDFLG = 2
-        GO TO 270
-  260   CONTINUE
-        IF (RS1.GT.0.0D0) GO TO 300
-        S2R = ZEROR
-        S2I = ZEROI
-        GO TO 230
-  270 CONTINUE
-      K = N
-  275 CONTINUE
-      IL = N - K
-      IF (IL.EQ.0) RETURN
-C-----------------------------------------------------------------------
-C     RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE
-C     K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP
-C     INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES.
-C-----------------------------------------------------------------------
-      S1R = CYR(1)
-      S1I = CYI(1)
-      S2R = CYR(2)
-      S2I = CYI(2)
-      CSR = CSRR(IFLAG)
-      ASCLE = BRY(IFLAG)
-      FN = DBLE(FLOAT(INU+IL))
-      DO 290 I=1,IL
-        C2R = S2R
-        C2I = S2I
-        S2R = S1R + (FN+FNF)*(RZR*C2R-RZI*C2I)
-        S2I = S1I + (FN+FNF)*(RZR*C2I+RZI*C2R)
-        S1R = C2R
-        S1I = C2I
-        FN = FN - 1.0D0
-        C2R = S2R*CSR
-        C2I = S2I*CSR
-        CKR = C2R
-        CKI = C2I
-        C1R = YR(KK)
-        C1I = YI(KK)
-        IF (KODE.EQ.1) GO TO 280
-        CALL ZS1S2(ZRR, ZRI, C1R, C1I, C2R, C2I, NW, ASC, ALIM, IUF)
-        NZ = NZ + NW
-  280   CONTINUE
-        YR(KK) = C1R*CSPNR - C1I*CSPNI + C2R
-        YI(KK) = C1R*CSPNI + C1I*CSPNR + C2I
-        KK = KK - 1
-        CSPNR = -CSPNR
-        CSPNI = -CSPNI
-        IF (IFLAG.GE.3) GO TO 290
-        C2R = DABS(CKR)
-        C2I = DABS(CKI)
-        C2M = DMAX1(C2R,C2I)
-        IF (C2M.LE.ASCLE) GO TO 290
-        IFLAG = IFLAG + 1
-        ASCLE = BRY(IFLAG)
-        S1R = S1R*CSR
-        S1I = S1I*CSR
-        S2R = CKR
-        S2I = CKI
-        S1R = S1R*CSSR(IFLAG)
-        S1I = S1I*CSSR(IFLAG)
-        S2R = S2R*CSSR(IFLAG)
-        S2I = S2I*CSSR(IFLAG)
-        CSR = CSRR(IFLAG)
-  290 CONTINUE
-      RETURN
-  300 CONTINUE
-      NZ = -1
-      RETURN
-      END

amos/zunk2.f

@@ -1,505 +0,0 @@
-      SUBROUTINE ZUNK2(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM,
-     * ALIM)
-C***BEGIN PROLOGUE  ZUNK2
-C***REFER TO  ZBESK
-C
-C     ZUNK2 COMPUTES K(FNU,Z) AND ITS ANALYTIC CONTINUATION FROM THE
-C     RIGHT HALF PLANE TO THE LEFT HALF PLANE BY MEANS OF THE
-C     UNIFORM ASYMPTOTIC EXPANSIONS FOR H(KIND,FNU,ZN) AND J(FNU,ZN)
-C     WHERE ZN IS IN THE RIGHT HALF PLANE, KIND=(3-MR)/2, MR=+1 OR
-C     -1. HERE ZN=ZR*I OR -ZR*I WHERE ZR=Z IF Z IS IN THE RIGHT
-C     HALF PLANE OR ZR=-Z IF Z IS IN THE LEFT HALF PLANE. MR INDIC-
-C     ATES THE DIRECTION OF ROTATION FOR ANALYTIC CONTINUATION.
-C     NZ=-1 MEANS AN OVERFLOW WILL OCCUR
-C
-C***ROUTINES CALLED  ZAIRY,ZKSCL,ZS1S2,ZUCHK,ZUNHJ,D1MACH,ZABS
-C***END PROLOGUE  ZUNK2
-C     COMPLEX AI,ARG,ARGD,ASUM,ASUMD,BSUM,BSUMD,CFN,CI,CIP,CK,CONE,CRSC,
-C    *CR1,CR2,CS,CSCL,CSGN,CSPN,CSR,CSS,CY,CZERO,C1,C2,DAI,PHI,PHID,RZ,
-C    *S1,S2,Y,Z,ZB,ZETA1,ZETA1D,ZETA2,ZETA2D,ZN,ZR
-      DOUBLE PRECISION AARG, AIC, AII, AIR, ALIM, ANG, APHI, ARGDI,
-     * ARGDR, ARGI, ARGR, ASC, ASCLE, ASUMDI, ASUMDR, ASUMI, ASUMR,
-     * BRY, BSUMDI, BSUMDR, BSUMI, BSUMR, CAR, CIPI, CIPR, CKI, CKR,
-     * CONER, CRSC, CR1I, CR1R, CR2I, CR2R, CSCL, CSGNI, CSI,
-     * CSPNI, CSPNR, CSR, CSRR, CSSR, CYI, CYR, C1I, C1R, C2I, C2M,
-     * C2R, DAII, DAIR, ELIM, FMR, FN, FNF, FNU, HPI, PHIDI, PHIDR,
-     * PHII, PHIR, PI, PTI, PTR, RAST, RAZR, RS1, RZI, RZR, SAR, SGN,
-     * STI, STR, S1I, S1R, S2I, S2R, TOL, YI, YR, YY, ZBI, ZBR, ZEROI,
-     * ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R, ZET1DI, ZET1DR, ZET2DI,
-     * ZET2DR, ZI, ZNI, ZNR, ZR, ZRI, ZRR, D1MACH, ZABS
-      INTEGER I, IB, IFLAG, IFN, IL, IN, INU, IUF, K, KDFLG, KFLAG, KK,
-     * KODE, MR, N, NAI, NDAI, NW, NZ, IDUM, J, IPARD, IC
-      DIMENSION BRY(3), YR(N), YI(N), ASUMR(2), ASUMI(2), BSUMR(2),
-     * BSUMI(2), PHIR(2), PHII(2), ARGR(2), ARGI(2), ZETA1R(2),
-     * ZETA1I(2), ZETA2R(2), ZETA2I(2), CYR(2), CYI(2), CIPR(4),
-     * CIPI(4), CSSR(3), CSRR(3)
-      DATA ZEROR,ZEROI,CONER,CR1R,CR1I,CR2R,CR2I /
-     1         0.0D0, 0.0D0, 1.0D0,
-     1 1.0D0,1.73205080756887729D0 , -0.5D0,-8.66025403784438647D-01 /
-      DATA HPI, PI, AIC /
-     1     1.57079632679489662D+00,     3.14159265358979324D+00,
-     1     1.26551212348464539D+00/
-      DATA CIPR(1),CIPI(1),CIPR(2),CIPI(2),CIPR(3),CIPI(3),CIPR(4),
-     * CIPI(4) /
-     1  1.0D0,0.0D0 ,  0.0D0,-1.0D0 ,  -1.0D0,0.0D0 ,  0.0D0,1.0D0 /
-C
-      KDFLG = 1
-      NZ = 0
-C-----------------------------------------------------------------------
-C     EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION GREATER THAN
-C     THE UNDERFLOW LIMIT
-C-----------------------------------------------------------------------
-      CSCL = 1.0D0/TOL
-      CRSC = TOL
-      CSSR(1) = CSCL
-      CSSR(2) = CONER
-      CSSR(3) = CRSC
-      CSRR(1) = CRSC
-      CSRR(2) = CONER
-      CSRR(3) = CSCL
-      BRY(1) = 1.0D+3*D1MACH(1)/TOL
-      BRY(2) = 1.0D0/BRY(1)
-      BRY(3) = D1MACH(2)
-      ZRR = ZR
-      ZRI = ZI
-      IF (ZR.GE.0.0D0) GO TO 10
-      ZRR = -ZR
-      ZRI = -ZI
-   10 CONTINUE
-      YY = ZRI
-      ZNR = ZRI
-      ZNI = -ZRR
-      ZBR = ZRR
-      ZBI = ZRI
-      INU = INT(SNGL(FNU))
-      FNF = FNU - DBLE(FLOAT(INU))
-      ANG = -HPI*FNF
-      CAR = DCOS(ANG)
-      SAR = DSIN(ANG)
-      C2R = HPI*SAR
-      C2I = -HPI*CAR
-      KK = MOD(INU,4) + 1
-      STR = C2R*CIPR(KK) - C2I*CIPI(KK)
-      STI = C2R*CIPI(KK) + C2I*CIPR(KK)
-      CSR = CR1R*STR - CR1I*STI
-      CSI = CR1R*STI + CR1I*STR
-      IF (YY.GT.0.0D0) GO TO 20
-      ZNR = -ZNR
-      ZBI = -ZBI
-   20 CONTINUE
-C-----------------------------------------------------------------------
-C     K(FNU,Z) IS COMPUTED FROM H(2,FNU,-I*Z) WHERE Z IS IN THE FIRST
-C     QUADRANT. FOURTH QUADRANT VALUES (YY.LE.0.0E0) ARE COMPUTED BY
-C     CONJUGATION SINCE THE K FUNCTION IS REAL ON THE POSITIVE REAL AXIS
-C-----------------------------------------------------------------------
-      J = 2
-      DO 80 I=1,N
-C-----------------------------------------------------------------------
-C     J FLIP FLOPS BETWEEN 1 AND 2 IN J = 3 - J
-C-----------------------------------------------------------------------
-        J = 3 - J
-        FN = FNU + DBLE(FLOAT(I-1))
-        CALL ZUNHJ(ZNR, ZNI, FN, 0, TOL, PHIR(J), PHII(J), ARGR(J),
-     *   ARGI(J), ZETA1R(J), ZETA1I(J), ZETA2R(J), ZETA2I(J), ASUMR(J),
-     *   ASUMI(J), BSUMR(J), BSUMI(J))
-        IF (KODE.EQ.1) GO TO 30
-        STR = ZBR + ZETA2R(J)
-        STI = ZBI + ZETA2I(J)
-        RAST = FN/ZABS(COMPLEX(STR,STI))
-        STR = STR*RAST*RAST
-        STI = -STI*RAST*RAST
-        S1R = ZETA1R(J) - STR
-        S1I = ZETA1I(J) - STI
-        GO TO 40
-   30   CONTINUE
-        S1R = ZETA1R(J) - ZETA2R(J)
-        S1I = ZETA1I(J) - ZETA2I(J)
-   40   CONTINUE
-C-----------------------------------------------------------------------
-C     TEST FOR UNDERFLOW AND OVERFLOW
-C-----------------------------------------------------------------------
-        RS1 = S1R
-        IF (DABS(RS1).GT.ELIM) GO TO 70
-        IF (KDFLG.EQ.1) KFLAG = 2
-        IF (DABS(RS1).LT.ALIM) GO TO 50
-C-----------------------------------------------------------------------
-C     REFINE  TEST AND SCALE
-C-----------------------------------------------------------------------
-        APHI = ZABS(COMPLEX(PHIR(J),PHII(J)))
-        AARG = ZABS(COMPLEX(ARGR(J),ARGI(J)))
-        RS1 = RS1 + DLOG(APHI) - 0.25D0*DLOG(AARG) - AIC
-        IF (DABS(RS1).GT.ELIM) GO TO 70
-        IF (KDFLG.EQ.1) KFLAG = 1
-        IF (RS1.LT.0.0D0) GO TO 50
-        IF (KDFLG.EQ.1) KFLAG = 3
-   50   CONTINUE
-C-----------------------------------------------------------------------
-C     SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR
-C     EXPONENT EXTREMES
-C-----------------------------------------------------------------------
-        C2R = ARGR(J)*CR2R - ARGI(J)*CR2I
-        C2I = ARGR(J)*CR2I + ARGI(J)*CR2R
-        CALL ZAIRY(C2R, C2I, 0, 2, AIR, AII, NAI, IDUM)
-        CALL ZAIRY(C2R, C2I, 1, 2, DAIR, DAII, NDAI, IDUM)
-        STR = DAIR*BSUMR(J) - DAII*BSUMI(J)
-        STI = DAIR*BSUMI(J) + DAII*BSUMR(J)
-        PTR = STR*CR2R - STI*CR2I
-        PTI = STR*CR2I + STI*CR2R
-        STR = PTR + (AIR*ASUMR(J)-AII*ASUMI(J))
-        STI = PTI + (AIR*ASUMI(J)+AII*ASUMR(J))
-        PTR = STR*PHIR(J) - STI*PHII(J)
-        PTI = STR*PHII(J) + STI*PHIR(J)
-        S2R = PTR*CSR - PTI*CSI
-        S2I = PTR*CSI + PTI*CSR
-        STR = DEXP(S1R)*CSSR(KFLAG)
-        S1R = STR*DCOS(S1I)
-        S1I = STR*DSIN(S1I)
-        STR = S2R*S1R - S2I*S1I
-        S2I = S1R*S2I + S2R*S1I
-        S2R = STR
-        IF (KFLAG.NE.1) GO TO 60
-        CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL)
-        IF (NW.NE.0) GO TO 70
-   60   CONTINUE
-        IF (YY.LE.0.0D0) S2I = -S2I
-        CYR(KDFLG) = S2R
-        CYI(KDFLG) = S2I
-        YR(I) = S2R*CSRR(KFLAG)
-        YI(I) = S2I*CSRR(KFLAG)
-        STR = CSI
-        CSI = -CSR
-        CSR = STR
-        IF (KDFLG.EQ.2) GO TO 85
-        KDFLG = 2
-        GO TO 80
-   70   CONTINUE
-        IF (RS1.GT.0.0D0) GO TO 320
-C-----------------------------------------------------------------------
-C     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW
-C-----------------------------------------------------------------------
-        IF (ZR.LT.0.0D0) GO TO 320
-        KDFLG = 1
-        YR(I)=ZEROR
-        YI(I)=ZEROI
-        NZ=NZ+1
-        STR = CSI
-        CSI =-CSR
-        CSR = STR
-        IF (I.EQ.1) GO TO 80
-        IF ((YR(I-1).EQ.ZEROR).AND.(YI(I-1).EQ.ZEROI)) GO TO 80
-        YR(I-1)=ZEROR
-        YI(I-1)=ZEROI
-        NZ=NZ+1
-   80 CONTINUE
-      I = N
-   85 CONTINUE
-      RAZR = 1.0D0/ZABS(COMPLEX(ZRR,ZRI))
-      STR = ZRR*RAZR
-      STI = -ZRI*RAZR
-      RZR = (STR+STR)*RAZR
-      RZI = (STI+STI)*RAZR
-      CKR = FN*RZR
-      CKI = FN*RZI
-      IB = I + 1
-      IF (N.LT.IB) GO TO 180
-C-----------------------------------------------------------------------
-C     TEST LAST MEMBER FOR UNDERFLOW AND OVERFLOW. SET SEQUENCE TO ZERO
-C     ON UNDERFLOW.
-C-----------------------------------------------------------------------
-      FN = FNU + DBLE(FLOAT(N-1))
-      IPARD = 1
-      IF (MR.NE.0) IPARD = 0
-      CALL ZUNHJ(ZNR, ZNI, FN, IPARD, TOL, PHIDR, PHIDI, ARGDR, ARGDI,
-     * ZET1DR, ZET1DI, ZET2DR, ZET2DI, ASUMDR, ASUMDI, BSUMDR, BSUMDI)
-      IF (KODE.EQ.1) GO TO 90
-      STR = ZBR + ZET2DR
-      STI = ZBI + ZET2DI
-      RAST = FN/ZABS(COMPLEX(STR,STI))
-      STR = STR*RAST*RAST
-      STI = -STI*RAST*RAST
-      S1R = ZET1DR - STR
-      S1I = ZET1DI - STI
-      GO TO 100
-   90 CONTINUE
-      S1R = ZET1DR - ZET2DR
-      S1I = ZET1DI - ZET2DI
-  100 CONTINUE
-      RS1 = S1R
-      IF (DABS(RS1).GT.ELIM) GO TO 105
-      IF (DABS(RS1).LT.ALIM) GO TO 120
-C----------------------------------------------------------------------------
-C     REFINE ESTIMATE AND TEST
-C-------------------------------------------------------------------------
-      APHI = ZABS(COMPLEX(PHIDR,PHIDI))
-      RS1 = RS1+DLOG(APHI)
-      IF (DABS(RS1).LT.ELIM) GO TO 120
-  105 CONTINUE
-      IF (RS1.GT.0.0D0) GO TO 320
-C-----------------------------------------------------------------------
-C     FOR ZR.LT.0.0, THE I FUNCTION TO BE ADDED WILL OVERFLOW
-C-----------------------------------------------------------------------
-      IF (ZR.LT.0.0D0) GO TO 320
-      NZ = N
-      DO 106 I=1,N
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-  106 CONTINUE
-      RETURN
-  120 CONTINUE
-      S1R = CYR(1)
-      S1I = CYI(1)
-      S2R = CYR(2)
-      S2I = CYI(2)
-      C1R = CSRR(KFLAG)
-      ASCLE = BRY(KFLAG)
-      DO 130 I=IB,N
-        C2R = S2R
-        C2I = S2I
-        S2R = CKR*C2R - CKI*C2I + S1R
-        S2I = CKR*C2I + CKI*C2R + S1I
-        S1R = C2R
-        S1I = C2I
-        CKR = CKR + RZR
-        CKI = CKI + RZI
-        C2R = S2R*C1R
-        C2I = S2I*C1R
-        YR(I) = C2R
-        YI(I) = C2I
-        IF (KFLAG.GE.3) GO TO 130
-        STR = DABS(C2R)
-        STI = DABS(C2I)
-        C2M = DMAX1(STR,STI)
-        IF (C2M.LE.ASCLE) GO TO 130
-        KFLAG = KFLAG + 1
-        ASCLE = BRY(KFLAG)
-        S1R = S1R*C1R
-        S1I = S1I*C1R
-        S2R = C2R
-        S2I = C2I
-        S1R = S1R*CSSR(KFLAG)
-        S1I = S1I*CSSR(KFLAG)
-        S2R = S2R*CSSR(KFLAG)
-        S2I = S2I*CSSR(KFLAG)
-        C1R = CSRR(KFLAG)
-  130 CONTINUE
-  180 CONTINUE
-      IF (MR.EQ.0) RETURN
-C-----------------------------------------------------------------------
-C     ANALYTIC CONTINUATION FOR RE(Z).LT.0.0D0
-C-----------------------------------------------------------------------
-      NZ = 0
-      FMR = DBLE(FLOAT(MR))
-      SGN = -DSIGN(PI,FMR)
-C-----------------------------------------------------------------------
-C     CSPN AND CSGN ARE COEFF OF K AND I FUNCIONS RESP.
-C-----------------------------------------------------------------------
-      CSGNI = SGN
-      IF (YY.LE.0.0D0) CSGNI = -CSGNI
-      IFN = INU + N - 1
-      ANG = FNF*SGN
-      CSPNR = DCOS(ANG)
-      CSPNI = DSIN(ANG)
-      IF (MOD(IFN,2).EQ.0) GO TO 190
-      CSPNR = -CSPNR
-      CSPNI = -CSPNI
-  190 CONTINUE
-C-----------------------------------------------------------------------
-C     CS=COEFF OF THE J FUNCTION TO GET THE I FUNCTION. I(FNU,Z) IS
-C     COMPUTED FROM EXP(I*FNU*HPI)*J(FNU,-I*Z) WHERE Z IS IN THE FIRST
-C     QUADRANT. FOURTH QUADRANT VALUES (YY.LE.0.0E0) ARE COMPUTED BY
-C     CONJUGATION SINCE THE I FUNCTION IS REAL ON THE POSITIVE REAL AXIS
-C-----------------------------------------------------------------------
-      CSR = SAR*CSGNI
-      CSI = CAR*CSGNI
-      IN = MOD(IFN,4) + 1
-      C2R = CIPR(IN)
-      C2I = CIPI(IN)
-      STR = CSR*C2R + CSI*C2I
-      CSI = -CSR*C2I + CSI*C2R
-      CSR = STR
-      ASC = BRY(1)
-      IUF = 0
-      KK = N
-      KDFLG = 1
-      IB = IB - 1
-      IC = IB - 1
-      DO 290 K=1,N
-        FN = FNU + DBLE(FLOAT(KK-1))
-C-----------------------------------------------------------------------
-C     LOGIC TO SORT OUT CASES WHOSE PARAMETERS WERE SET FOR THE K
-C     FUNCTION ABOVE
-C-----------------------------------------------------------------------
-        IF (N.GT.2) GO TO 175
-  172   CONTINUE
-        PHIDR = PHIR(J)
-        PHIDI = PHII(J)
-        ARGDR = ARGR(J)
-        ARGDI = ARGI(J)
-        ZET1DR = ZETA1R(J)
-        ZET1DI = ZETA1I(J)
-        ZET2DR = ZETA2R(J)
-        ZET2DI = ZETA2I(J)
-        ASUMDR = ASUMR(J)
-        ASUMDI = ASUMI(J)
-        BSUMDR = BSUMR(J)
-        BSUMDI = BSUMI(J)
-        J = 3 - J
-        GO TO 210
-  175   CONTINUE
-        IF ((KK.EQ.N).AND.(IB.LT.N)) GO TO 210
-        IF ((KK.EQ.IB).OR.(KK.EQ.IC)) GO TO 172
-        CALL ZUNHJ(ZNR, ZNI, FN, 0, TOL, PHIDR, PHIDI, ARGDR,
-     *   ARGDI, ZET1DR, ZET1DI, ZET2DR, ZET2DI, ASUMDR,
-     *   ASUMDI, BSUMDR, BSUMDI)
-  210   CONTINUE
-        IF (KODE.EQ.1) GO TO 220
-        STR = ZBR + ZET2DR
-        STI = ZBI + ZET2DI
-        RAST = FN/ZABS(COMPLEX(STR,STI))
-        STR = STR*RAST*RAST
-        STI = -STI*RAST*RAST
-        S1R = -ZET1DR + STR
-        S1I = -ZET1DI + STI
-        GO TO 230
-  220   CONTINUE
-        S1R = -ZET1DR + ZET2DR
-        S1I = -ZET1DI + ZET2DI
-  230   CONTINUE
-C-----------------------------------------------------------------------
-C     TEST FOR UNDERFLOW AND OVERFLOW
-C-----------------------------------------------------------------------
-        RS1 = S1R
-        IF (DABS(RS1).GT.ELIM) GO TO 280
-        IF (KDFLG.EQ.1) IFLAG = 2
-        IF (DABS(RS1).LT.ALIM) GO TO 240
-C-----------------------------------------------------------------------
-C     REFINE  TEST AND SCALE
-C-----------------------------------------------------------------------
-        APHI = ZABS(COMPLEX(PHIDR,PHIDI))
-        AARG = ZABS(COMPLEX(ARGDR,ARGDI))
-        RS1 = RS1 + DLOG(APHI) - 0.25D0*DLOG(AARG) - AIC
-        IF (DABS(RS1).GT.ELIM) GO TO 280
-        IF (KDFLG.EQ.1) IFLAG = 1
-        IF (RS1.LT.0.0D0) GO TO 240
-        IF (KDFLG.EQ.1) IFLAG = 3
-  240   CONTINUE
-        CALL ZAIRY(ARGDR, ARGDI, 0, 2, AIR, AII, NAI, IDUM)
-        CALL ZAIRY(ARGDR, ARGDI, 1, 2, DAIR, DAII, NDAI, IDUM)
-        STR = DAIR*BSUMDR - DAII*BSUMDI
-        STI = DAIR*BSUMDI + DAII*BSUMDR
-        STR = STR + (AIR*ASUMDR-AII*ASUMDI)
-        STI = STI + (AIR*ASUMDI+AII*ASUMDR)
-        PTR = STR*PHIDR - STI*PHIDI
-        PTI = STR*PHIDI + STI*PHIDR
-        S2R = PTR*CSR - PTI*CSI
-        S2I = PTR*CSI + PTI*CSR
-        STR = DEXP(S1R)*CSSR(IFLAG)
-        S1R = STR*DCOS(S1I)
-        S1I = STR*DSIN(S1I)
-        STR = S2R*S1R - S2I*S1I
-        S2I = S2R*S1I + S2I*S1R
-        S2R = STR
-        IF (IFLAG.NE.1) GO TO 250
-        CALL ZUCHK(S2R, S2I, NW, BRY(1), TOL)
-        IF (NW.EQ.0) GO TO 250
-        S2R = ZEROR
-        S2I = ZEROI
-  250   CONTINUE
-        IF (YY.LE.0.0D0) S2I = -S2I
-        CYR(KDFLG) = S2R
-        CYI(KDFLG) = S2I
-        C2R = S2R
-        C2I = S2I
-        S2R = S2R*CSRR(IFLAG)
-        S2I = S2I*CSRR(IFLAG)
-C-----------------------------------------------------------------------
-C     ADD I AND K FUNCTIONS, K SEQUENCE IN Y(I), I=1,N
-C-----------------------------------------------------------------------
-        S1R = YR(KK)
-        S1I = YI(KK)
-        IF (KODE.EQ.1) GO TO 270
-        CALL ZS1S2(ZRR, ZRI, S1R, S1I, S2R, S2I, NW, ASC, ALIM, IUF)
-        NZ = NZ + NW
-  270   CONTINUE
-        YR(KK) = S1R*CSPNR - S1I*CSPNI + S2R
-        YI(KK) = S1R*CSPNI + S1I*CSPNR + S2I
-        KK = KK - 1
-        CSPNR = -CSPNR
-        CSPNI = -CSPNI
-        STR = CSI
-        CSI = -CSR
-        CSR = STR
-        IF (C2R.NE.0.0D0 .OR. C2I.NE.0.0D0) GO TO 255
-        KDFLG = 1
-        GO TO 290
-  255   CONTINUE
-        IF (KDFLG.EQ.2) GO TO 295
-        KDFLG = 2
-        GO TO 290
-  280   CONTINUE
-        IF (RS1.GT.0.0D0) GO TO 320
-        S2R = ZEROR
-        S2I = ZEROI
-        GO TO 250
-  290 CONTINUE
-      K = N
-  295 CONTINUE
-      IL = N - K
-      IF (IL.EQ.0) RETURN
-C-----------------------------------------------------------------------
-C     RECUR BACKWARD FOR REMAINDER OF I SEQUENCE AND ADD IN THE
-C     K FUNCTIONS, SCALING THE I SEQUENCE DURING RECURRENCE TO KEEP
-C     INTERMEDIATE ARITHMETIC ON SCALE NEAR EXPONENT EXTREMES.
-C-----------------------------------------------------------------------
-      S1R = CYR(1)
-      S1I = CYI(1)
-      S2R = CYR(2)
-      S2I = CYI(2)
-      CSR = CSRR(IFLAG)
-      ASCLE = BRY(IFLAG)
-      FN = DBLE(FLOAT(INU+IL))
-      DO 310 I=1,IL
-        C2R = S2R
-        C2I = S2I
-        S2R = S1R + (FN+FNF)*(RZR*C2R-RZI*C2I)
-        S2I = S1I + (FN+FNF)*(RZR*C2I+RZI*C2R)
-        S1R = C2R
-        S1I = C2I
-        FN = FN - 1.0D0
-        C2R = S2R*CSR
-        C2I = S2I*CSR
-        CKR = C2R
-        CKI = C2I
-        C1R = YR(KK)
-        C1I = YI(KK)
-        IF (KODE.EQ.1) GO TO 300
-        CALL ZS1S2(ZRR, ZRI, C1R, C1I, C2R, C2I, NW, ASC, ALIM, IUF)
-        NZ = NZ + NW
-  300   CONTINUE
-        YR(KK) = C1R*CSPNR - C1I*CSPNI + C2R
-        YI(KK) = C1R*CSPNI + C1I*CSPNR + C2I
-        KK = KK - 1
-        CSPNR = -CSPNR
-        CSPNI = -CSPNI
-        IF (IFLAG.GE.3) GO TO 310
-        C2R = DABS(CKR)
-        C2I = DABS(CKI)
-        C2M = DMAX1(C2R,C2I)
-        IF (C2M.LE.ASCLE) GO TO 310
-        IFLAG = IFLAG + 1
-        ASCLE = BRY(IFLAG)
-        S1R = S1R*CSR
-        S1I = S1I*CSR
-        S2R = CKR
-        S2I = CKI
-        S1R = S1R*CSSR(IFLAG)
-        S1I = S1I*CSSR(IFLAG)
-        S2R = S2R*CSSR(IFLAG)
-        S2I = S2I*CSSR(IFLAG)
-        CSR = CSRR(IFLAG)
-  310 CONTINUE
-      RETURN
-  320 CONTINUE
-      NZ = -1
-      RETURN
-      END

amos/zuoik.f

@@ -1,194 +0,0 @@
-      SUBROUTINE ZUOIK(ZR, ZI, FNU, KODE, IKFLG, N, YR, YI, NUF, TOL,
-     * ELIM, ALIM)
-C***BEGIN PROLOGUE  ZUOIK
-C***REFER TO  ZBESI,ZBESK,ZBESH
-C
-C     ZUOIK COMPUTES THE LEADING TERMS OF THE UNIFORM ASYMPTOTIC
-C     EXPANSIONS FOR THE I AND K FUNCTIONS AND COMPARES THEM
-C     (IN LOGARITHMIC FORM) TO ALIM AND ELIM FOR OVER AND UNDERFLOW
-C     WHERE ALIM.LT.ELIM. IF THE MAGNITUDE, BASED ON THE LEADING
-C     EXPONENTIAL, IS LESS THAN ALIM OR GREATER THAN -ALIM, THEN
-C     THE RESULT IS ON SCALE. IF NOT, THEN A REFINED TEST USING OTHER
-C     MULTIPLIERS (IN LOGARITHMIC FORM) IS MADE BASED ON ELIM. HERE
-C     EXP(-ELIM)=SMALLEST MACHINE NUMBER*1.0E+3 AND EXP(-ALIM)=
-C     EXP(-ELIM)/TOL
-C
-C     IKFLG=1 MEANS THE I SEQUENCE IS TESTED
-C          =2 MEANS THE K SEQUENCE IS TESTED
-C     NUF = 0 MEANS THE LAST MEMBER OF THE SEQUENCE IS ON SCALE
-C         =-1 MEANS AN OVERFLOW WOULD OCCUR
-C     IKFLG=1 AND NUF.GT.0 MEANS THE LAST NUF Y VALUES WERE SET TO ZERO
-C             THE FIRST N-NUF VALUES MUST BE SET BY ANOTHER ROUTINE
-C     IKFLG=2 AND NUF.EQ.N MEANS ALL Y VALUES WERE SET TO ZERO
-C     IKFLG=2 AND 0.LT.NUF.LT.N NOT CONSIDERED. Y MUST BE SET BY
-C             ANOTHER ROUTINE
-C
-C***ROUTINES CALLED  ZUCHK,ZUNHJ,ZUNIK,D1MACH,ZABS,ZLOG
-C***END PROLOGUE  ZUOIK
-C     COMPLEX ARG,ASUM,BSUM,CWRK,CZ,CZERO,PHI,SUM,Y,Z,ZB,ZETA1,ZETA2,ZN,
-C    *ZR
-      DOUBLE PRECISION AARG, AIC, ALIM, APHI, ARGI, ARGR, ASUMI, ASUMR,
-     * ASCLE, AX, AY, BSUMI, BSUMR, CWRKI, CWRKR, CZI, CZR, ELIM, FNN,
-     * FNU, GNN, GNU, PHII, PHIR, RCZ, STR, STI, SUMI, SUMR, TOL, YI,
-     * YR, ZBI, ZBR, ZEROI, ZEROR, ZETA1I, ZETA1R, ZETA2I, ZETA2R, ZI,
-     * ZNI, ZNR, ZR, ZRI, ZRR, D1MACH, ZABS
-      INTEGER I, IDUM, IFORM, IKFLG, INIT, KODE, N, NN, NUF, NW
-      DIMENSION YR(N), YI(N), CWRKR(16), CWRKI(16)
-      DATA ZEROR,ZEROI / 0.0D0, 0.0D0 /
-      DATA AIC / 1.265512123484645396D+00 /
-      NUF = 0
-      NN = N
-      ZRR = ZR
-      ZRI = ZI
-      IF (ZR.GE.0.0D0) GO TO 10
-      ZRR = -ZR
-      ZRI = -ZI
-   10 CONTINUE
-      ZBR = ZRR
-      ZBI = ZRI
-      AX = DABS(ZR)*1.7321D0
-      AY = DABS(ZI)
-      IFORM = 1
-      IF (AY.GT.AX) IFORM = 2
-      GNU = DMAX1(FNU,1.0D0)
-      IF (IKFLG.EQ.1) GO TO 20
-      FNN = DBLE(FLOAT(NN))
-      GNN = FNU + FNN - 1.0D0
-      GNU = DMAX1(GNN,FNN)
-   20 CONTINUE
-C-----------------------------------------------------------------------
-C     ONLY THE MAGNITUDE OF ARG AND PHI ARE NEEDED ALONG WITH THE
-C     REAL PARTS OF ZETA1, ZETA2 AND ZB. NO ATTEMPT IS MADE TO GET
-C     THE SIGN OF THE IMAGINARY PART CORRECT.
-C-----------------------------------------------------------------------
-      IF (IFORM.EQ.2) GO TO 30
-      INIT = 0
-      CALL ZUNIK(ZRR, ZRI, GNU, IKFLG, 1, TOL, INIT, PHIR, PHII,
-     * ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)
-      CZR = -ZETA1R + ZETA2R
-      CZI = -ZETA1I + ZETA2I
-      GO TO 50
-   30 CONTINUE
-      ZNR = ZRI
-      ZNI = -ZRR
-      IF (ZI.GT.0.0D0) GO TO 40
-      ZNR = -ZNR
-   40 CONTINUE
-      CALL ZUNHJ(ZNR, ZNI, GNU, 1, TOL, PHIR, PHII, ARGR, ARGI, ZETA1R,
-     * ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
-      CZR = -ZETA1R + ZETA2R
-      CZI = -ZETA1I + ZETA2I
-      AARG = ZABS(COMPLEX(ARGR,ARGI))
-   50 CONTINUE
-      IF (KODE.EQ.1) GO TO 60
-      CZR = CZR - ZBR
-      CZI = CZI - ZBI
-   60 CONTINUE
-      IF (IKFLG.EQ.1) GO TO 70
-      CZR = -CZR
-      CZI = -CZI
-   70 CONTINUE
-      APHI = ZABS(COMPLEX(PHIR,PHII))
-      RCZ = CZR
-C-----------------------------------------------------------------------
-C     OVERFLOW TEST
-C-----------------------------------------------------------------------
-      IF (RCZ.GT.ELIM) GO TO 210
-      IF (RCZ.LT.ALIM) GO TO 80
-      RCZ = RCZ + DLOG(APHI)
-      IF (IFORM.EQ.2) RCZ = RCZ - 0.25D0*DLOG(AARG) - AIC
-      IF (RCZ.GT.ELIM) GO TO 210
-      GO TO 130
-   80 CONTINUE
-C-----------------------------------------------------------------------
-C     UNDERFLOW TEST
-C-----------------------------------------------------------------------
-      IF (RCZ.LT.(-ELIM)) GO TO 90
-      IF (RCZ.GT.(-ALIM)) GO TO 130
-      RCZ = RCZ + DLOG(APHI)
-      IF (IFORM.EQ.2) RCZ = RCZ - 0.25D0*DLOG(AARG) - AIC
-      IF (RCZ.GT.(-ELIM)) GO TO 110
-   90 CONTINUE
-      DO 100 I=1,NN
-        YR(I) = ZEROR
-        YI(I) = ZEROI
-  100 CONTINUE
-      NUF = NN
-      RETURN
-  110 CONTINUE
-      ASCLE = 1.0D+3*D1MACH(1)/TOL
-      CALL ZLOG(PHIR, PHII, STR, STI, IDUM)
-      CZR = CZR + STR
-      CZI = CZI + STI
-      IF (IFORM.EQ.1) GO TO 120
-      CALL ZLOG(ARGR, ARGI, STR, STI, IDUM)
-      CZR = CZR - 0.25D0*STR - AIC
-      CZI = CZI - 0.25D0*STI
-  120 CONTINUE
-      AX = DEXP(RCZ)/TOL
-      AY = CZI
-      CZR = AX*DCOS(AY)
-      CZI = AX*DSIN(AY)
-      CALL ZUCHK(CZR, CZI, NW, ASCLE, TOL)
-      IF (NW.NE.0) GO TO 90
-  130 CONTINUE
-      IF (IKFLG.EQ.2) RETURN
-      IF (N.EQ.1) RETURN
-C-----------------------------------------------------------------------
-C     SET UNDERFLOWS ON I SEQUENCE
-C-----------------------------------------------------------------------
-  140 CONTINUE
-      GNU = FNU + DBLE(FLOAT(NN-1))
-      IF (IFORM.EQ.2) GO TO 150
-      INIT = 0
-      CALL ZUNIK(ZRR, ZRI, GNU, IKFLG, 1, TOL, INIT, PHIR, PHII,
-     * ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)
-      CZR = -ZETA1R + ZETA2R
-      CZI = -ZETA1I + ZETA2I
-      GO TO 160
-  150 CONTINUE
-      CALL ZUNHJ(ZNR, ZNI, GNU, 1, TOL, PHIR, PHII, ARGR, ARGI, ZETA1R,
-     * ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
-      CZR = -ZETA1R + ZETA2R
-      CZI = -ZETA1I + ZETA2I
-      AARG = ZABS(COMPLEX(ARGR,ARGI))
-  160 CONTINUE
-      IF (KODE.EQ.1) GO TO 170
-      CZR = CZR - ZBR
-      CZI = CZI - ZBI
-  170 CONTINUE
-      APHI = ZABS(COMPLEX(PHIR,PHII))
-      RCZ = CZR
-      IF (RCZ.LT.(-ELIM)) GO TO 180
-      IF (RCZ.GT.(-ALIM)) RETURN
-      RCZ = RCZ + DLOG(APHI)
-      IF (IFORM.EQ.2) RCZ = RCZ - 0.25D0*DLOG(AARG) - AIC
-      IF (RCZ.GT.(-ELIM)) GO TO 190
-  180 CONTINUE
-      YR(NN) = ZEROR
-      YI(NN) = ZEROI
-      NN = NN - 1
-      NUF = NUF + 1
-      IF (NN.EQ.0) RETURN
-      GO TO 140
-  190 CONTINUE
-      ASCLE = 1.0D+3*D1MACH(1)/TOL
-      CALL ZLOG(PHIR, PHII, STR, STI, IDUM)
-      CZR = CZR + STR
-      CZI = CZI + STI
-      IF (IFORM.EQ.1) GO TO 200
-      CALL ZLOG(ARGR, ARGI, STR, STI, IDUM)
-      CZR = CZR - 0.25D0*STR - AIC
-      CZI = CZI - 0.25D0*STI
-  200 CONTINUE
-      AX = DEXP(RCZ)/TOL
-      AY = CZI
-      CZR = AX*DCOS(AY)
-      CZI = AX*DSIN(AY)
-      CALL ZUCHK(CZR, CZI, NW, ASCLE, TOL)
-      IF (NW.NE.0) GO TO 180
-      RETURN
-  210 CONTINUE
-      NUF = -1
-      RETURN
-      END

amos/zwrsk.f

@@ -1,94 +0,0 @@
-      SUBROUTINE ZWRSK(ZRR, ZRI, FNU, KODE, N, YR, YI, NZ, CWR, CWI,
-     * TOL, ELIM, ALIM)
-C***BEGIN PROLOGUE  ZWRSK
-C***REFER TO  ZBESI,ZBESK
-C
-C     ZWRSK COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY
-C     NORMALIZING THE I FUNCTION RATIOS FROM ZRATI BY THE WRONSKIAN
-C
-C***ROUTINES CALLED  D1MACH,ZBKNU,ZRATI,ZABS
-C***END PROLOGUE  ZWRSK
-C     COMPLEX CINU,CSCL,CT,CW,C1,C2,RCT,ST,Y,ZR
-      DOUBLE PRECISION ACT, ACW, ALIM, ASCLE, CINUI, CINUR, CSCLR, CTI,
-     * CTR, CWI, CWR, C1I, C1R, C2I, C2R, ELIM, FNU, PTI, PTR, RACT,
-     * STI, STR, TOL, YI, YR, ZRI, ZRR, ZABS, D1MACH
-      INTEGER I, KODE, N, NW, NZ
-      DIMENSION YR(N), YI(N), CWR(2), CWI(2)
-C-----------------------------------------------------------------------
-C     I(FNU+I-1,Z) BY BACKWARD RECURRENCE FOR RATIOS
-C     Y(I)=I(FNU+I,Z)/I(FNU+I-1,Z) FROM CRATI NORMALIZED BY THE
-C     WRONSKIAN WITH K(FNU,Z) AND K(FNU+1,Z) FROM CBKNU.
-C-----------------------------------------------------------------------
-      NZ = 0
-      CALL ZBKNU(ZRR, ZRI, FNU, KODE, 2, CWR, CWI, NW, TOL, ELIM, ALIM)
-      IF (NW.NE.0) GO TO 50
-      CALL ZRATI(ZRR, ZRI, FNU, N, YR, YI, TOL)
-C-----------------------------------------------------------------------
-C     RECUR FORWARD ON I(FNU+1,Z) = R(FNU,Z)*I(FNU,Z),
-C     R(FNU+J-1,Z)=Y(J),  J=1,...,N
-C-----------------------------------------------------------------------
-      CINUR = 1.0D0
-      CINUI = 0.0D0
-      IF (KODE.EQ.1) GO TO 10
-      CINUR = DCOS(ZRI)
-      CINUI = DSIN(ZRI)
-   10 CONTINUE
-C-----------------------------------------------------------------------
-C     ON LOW EXPONENT MACHINES THE K FUNCTIONS CAN BE CLOSE TO BOTH
-C     THE UNDER AND OVERFLOW LIMITS AND THE NORMALIZATION MUST BE
-C     SCALED TO PREVENT OVER OR UNDERFLOW. CUOIK HAS DETERMINED THAT
-C     THE RESULT IS ON SCALE.
-C-----------------------------------------------------------------------
-      ACW = ZABS(COMPLEX(CWR(2),CWI(2)))
-      ASCLE = 1.0D+3*D1MACH(1)/TOL
-      CSCLR = 1.0D0
-      IF (ACW.GT.ASCLE) GO TO 20
-      CSCLR = 1.0D0/TOL
-      GO TO 30
-   20 CONTINUE
-      ASCLE = 1.0D0/ASCLE
-      IF (ACW.LT.ASCLE) GO TO 30
-      CSCLR = TOL
-   30 CONTINUE
-      C1R = CWR(1)*CSCLR
-      C1I = CWI(1)*CSCLR
-      C2R = CWR(2)*CSCLR
-      C2I = CWI(2)*CSCLR
-      STR = YR(1)
-      STI = YI(1)
-C-----------------------------------------------------------------------
-C     CINU=CINU*(CONJG(CT)/CABS(CT))*(1.0D0/CABS(CT) PREVENTS
-C     UNDER- OR OVERFLOW PREMATURELY BY SQUARING CABS(CT)
-C-----------------------------------------------------------------------
-      PTR = STR*C1R - STI*C1I
-      PTI = STR*C1I + STI*C1R
-      PTR = PTR + C2R
-      PTI = PTI + C2I
-      CTR = ZRR*PTR - ZRI*PTI
-      CTI = ZRR*PTI + ZRI*PTR
-      ACT = ZABS(COMPLEX(CTR,CTI))
-      RACT = 1.0D0/ACT
-      CTR = CTR*RACT
-      CTI = -CTI*RACT
-      PTR = CINUR*RACT
-      PTI = CINUI*RACT
-      CINUR = PTR*CTR - PTI*CTI
-      CINUI = PTR*CTI + PTI*CTR
-      YR(1) = CINUR*CSCLR
-      YI(1) = CINUI*CSCLR
-      IF (N.EQ.1) RETURN
-      DO 40 I=2,N
-        PTR = STR*CINUR - STI*CINUI
-        CINUI = STR*CINUI + STI*CINUR
-        CINUR = PTR
-        STR = YR(I)
-        STI = YI(I)
-        YR(I) = CINUR*CSCLR
-        YI(I) = CINUI*CSCLR
-   40 CONTINUE
-      RETURN
-   50 CONTINUE
-      NZ = -1
-      IF(NW.EQ.(-2)) NZ=-2
-      RETURN
-      END