← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dbesk1.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/dbesk1.f
 
1
*DECK DBESK1
 
2
      DOUBLE PRECISION FUNCTION DBESK1 (X)
 
3
C***BEGIN PROLOGUE  DBESK1
 
4
C***PURPOSE  Compute the modified (hyperbolic) Bessel function of the
 
5
C            third kind of order one.
 
6
C***LIBRARY   SLATEC (FNLIB)
 
7
C***CATEGORY  C10B1
 
8
C***TYPE      DOUBLE PRECISION (BESK1-S, DBESK1-D)
 
9
C***KEYWORDS  FNLIB, HYPERBOLIC BESSEL FUNCTION,
 
10
C             MODIFIED BESSEL FUNCTION, ORDER ONE, SPECIAL FUNCTIONS,
 
11
C             THIRD KIND
 
12
C***AUTHOR  Fullerton, W., (LANL)
 
13
C***DESCRIPTION
 
14
C
 
15
C DBESK1(X) calculates the double precision modified (hyperbolic)
 
16
C Bessel function of the third kind of order one for double precision
 
17
C argument X.  The argument must be large enough that the result does
 
18
C not overflow and small enough that the result does not underflow.
 
19
C
 
20
C Series for BK1        on the interval  0.          to  4.00000E+00
 
21
C                                        with weighted error   9.16E-32
 
22
C                                         log weighted error  31.04
 
23
C                               significant figures required  30.61
 
24
C                                    decimal places required  31.64
 
25
C
 
26
C***REFERENCES  (NONE)
 
27
C***ROUTINES CALLED  D1MACH, DBESI1, DBSK1E, DCSEVL, INITDS, XERMSG
 
28
C***REVISION HISTORY  (YYMMDD)
 
29
C   770701  DATE WRITTEN
 
30
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
31
C   890531  REVISION DATE from Version 3.2
 
32
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
33
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
 
34
C***END PROLOGUE  DBESK1
 
35
      DOUBLE PRECISION X, BK1CS(16), XMAX, XMAXT, XMIN, XSML, Y,
 
36
     1  D1MACH, DCSEVL, DBESI1, DBSK1E
 
37
      LOGICAL FIRST
 
38
      SAVE BK1CS, NTK1, XMIN, XSML, XMAX, FIRST
 
39
      DATA BK1CS(  1) / +.2530022733 8947770532 5311208685 33 D-1     /
 
40
      DATA BK1CS(  2) / -.3531559607 7654487566 7238316918 01 D+0     /
 
41
      DATA BK1CS(  3) / -.1226111808 2265714823 4790679300 42 D+0     /
 
42
      DATA BK1CS(  4) / -.6975723859 6398643501 8129202960 83 D-2     /
 
43
      DATA BK1CS(  5) / -.1730288957 5130520630 1765073689 79 D-3     /
 
44
      DATA BK1CS(  6) / -.2433406141 5659682349 6007350301 64 D-5     /
 
45
      DATA BK1CS(  7) / -.2213387630 7347258558 3152525451 26 D-7     /
 
46
      DATA BK1CS(  8) / -.1411488392 6335277610 9583302126 08 D-9     /
 
47
      DATA BK1CS(  9) / -.6666901694 1993290060 8537512643 73 D-12    /
 
48
      DATA BK1CS( 10) / -.2427449850 5193659339 2631968648 53 D-14    /
 
49
      DATA BK1CS( 11) / -.7023863479 3862875971 7837971200 00 D-17    /
 
50
      DATA BK1CS( 12) / -.1654327515 5100994675 4910293333 33 D-19    /
 
51
      DATA BK1CS( 13) / -.3233834745 9944491991 8933333333 33 D-22    /
 
52
      DATA BK1CS( 14) / -.5331275052 9265274999 4666666666 66 D-25    /
 
53
      DATA BK1CS( 15) / -.7513040716 2157226666 6666666666 66 D-28    /
 
54
      DATA BK1CS( 16) / -.9155085717 6541866666 6666666666 66 D-31    /
 
55
      DATA FIRST /.TRUE./
 
56
C***FIRST EXECUTABLE STATEMENT  DBESK1
 
57
      IF (FIRST) THEN
 
58
         NTK1 = INITDS (BK1CS, 16, 0.1*REAL(D1MACH(3)))
 
59
         XMIN = EXP(MAX(LOG(D1MACH(1)), -LOG(D1MACH(2))) + 0.01D0)
 
60
         XSML = SQRT(4.0D0*D1MACH(3))
 
61
         XMAXT = -LOG(D1MACH(1))
 
62
         XMAX = XMAXT - 0.5D0*XMAXT*LOG(XMAXT)/(XMAXT+0.5D0)
 
63
      ENDIF
 
64
      FIRST = .FALSE.
 
65
C
 
66
      IF (X .LE. 0.D0) CALL XERMSG ('SLATEC', 'DBESK1',
 
67
     +   'X IS ZERO OR NEGATIVE', 2, 2)
 
68
      IF (X.GT.2.0D0) GO TO 20
 
69
C
 
70
      IF (X .LT. XMIN) CALL XERMSG ('SLATEC', 'DBESK1',
 
71
     +   'X SO SMALL K1 OVERFLOWS', 3, 2)
 
72
      Y = 0.D0
 
73
      IF (X.GT.XSML) Y = X*X
 
74
      DBESK1 = LOG(0.5D0*X)*DBESI1(X) + (0.75D0 + DCSEVL (.5D0*Y-1.D0,
 
75
     1  BK1CS, NTK1))/X
 
76
      RETURN
 
77
C
 
78
 20   DBESK1 = 0.D0
 
79
      IF (X .GT. XMAX) CALL XERMSG ('SLATEC', 'DBESK1',
 
80
     +   'X SO BIG K1 UNDERFLOWS', 1, 1)
 
81
      IF (X.GT.XMAX) RETURN
 
82
C
 
83
      DBESK1 = EXP(-X) * DBSK1E(X)
 
84
C
 
85
      RETURN
 
86
      END