← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to src/numerical/slatec/derf.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/numerical/slatec/derf.lisp
1
 
;;; Compiled by f2cl version 2.0 beta 2002-05-06
 
1
;;; Compiled by f2cl version 2.0 beta Date: 2006/01/31 15:11:05 
 
2
;;; Using Lisp CMU Common Lisp Snapshot 2006-01 (19C)
2
3
;;; 
3
4
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
4
5
;;;           (:coerce-assigns :as-needed) (:array-type ':simple-array)
5
6
;;;           (:array-slicing nil) (:declare-common nil)
6
7
;;;           (:float-format double-float))
7
8
 
8
 
(in-package "SLATEC")
 
9
(in-package :slatec)
9
10
 
10
11
 
11
12
(let ((nterf 0)
12
13
      (xbig 0.0)
13
14
      (sqeps 0.0)
14
 
      (erfcs (make-array 21 :element-type 'double-float))
 
15
      (erfcs
 
16
       (make-array 21
 
17
                   :element-type 'double-float
 
18
                   :initial-contents '(-0.049046121234691806
 
19
                                       -0.14226120510371365
 
20
                                       0.010035582187599796
 
21
                                       -5.768764699767485e-4
 
22
                                       2.741993125219606e-5
 
23
                                       -1.1043175507344507e-6
 
24
                                       3.8488755420345036e-8
 
25
                                       -1.1808582533875466e-9
 
26
                                       3.2334215826050907e-11
 
27
                                       -7.991015947004549e-13
 
28
                                       1.7990725113961456e-14
 
29
                                       -3.718635487818693e-16
 
30
                                       7.103599003714253e-18
 
31
                                       -1.2612455119155226e-19
 
32
                                       2.0916406941769294e-21
 
33
                                       -3.2539731029314073e-23
 
34
                                       4.766867209797675e-25
 
35
                                       -6.598012078285134e-27
 
36
                                       8.655011469963763e-29
 
37
                                       -1.0788925177498064e-30
 
38
                                       1.2811883993017003e-32)))
15
39
      (sqrtpi 1.772453850905516)
16
 
      (first nil))
17
 
  (declare (type f2cl-lib:logical first)
 
40
      (first$ nil))
 
41
  (declare (type f2cl-lib:logical first$)
18
42
           (type (simple-array double-float (21)) erfcs)
19
43
           (type double-float sqrtpi sqeps xbig)
20
44
           (type f2cl-lib:integer4 nterf))
21
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (1) ((1 21))) -0.04904612123469181)
22
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (2) ((1 21))) -0.14226120510371365)
23
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (3) ((1 21))) 0.010035582187599796)
24
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (4) ((1 21))) -5.768764699767486e-4)
25
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (5) ((1 21))) 2.7419931252196067e-5)
26
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (6) ((1 21))) -1.1043175507344509e-6)
27
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (7) ((1 21))) 3.8488755420345033e-8)
28
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (8) ((1 21))) -1.1808582533875464e-9)
29
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (9) ((1 21))) 3.233421582605091e-11)
30
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (10) ((1 21))) -7.991015947004547e-13)
31
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (11) ((1 21))) 1.7990725113961456e-14)
32
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (12) ((1 21))) -3.7186354878186934e-16)
33
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (13) ((1 21))) 7.103599003714253e-18)
34
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (14) ((1 21))) -1.2612455119155225e-19)
35
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (15) ((1 21))) 2.0916406941769294e-21)
36
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (16) ((1 21))) -3.2539731029314073e-23)
37
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (17) ((1 21))) 4.7668672097976744e-25)
38
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (18) ((1 21))) -6.598012078285136e-27)
39
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (19) ((1 21))) 8.655011469963763e-29)
40
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (20) ((1 21))) -1.0788925177498063e-30)
41
 
  (f2cl-lib:fset (f2cl-lib:fref erfcs (21) ((1 21))) 1.2811883993017004e-32)
42
 
  (setq first f2cl-lib:%true%)
 
45
  (setq first$ f2cl-lib:%true%)
43
46
  (defun derf (x)
44
47
    (declare (type double-float x))
45
 
    (prog ((y 0.0) (derf 0.0))
46
 
      (declare (type double-float derf y))
 
48
    (prog ((y 0.0) (derf 0.0) (abs$ 0.0f0))
 
49
      (declare (type single-float abs$) (type double-float derf y))
47
50
      (cond
48
 
       (first
49
 
        (setf nterf
50
 
                (initds erfcs 21
51
 
                 (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3)))))
52
 
        (setf xbig
53
 
                (f2cl-lib:fsqrt
54
 
                 (- (f2cl-lib:flog (* sqrtpi (f2cl-lib:d1mach 3))))))
55
 
        (setf sqeps (f2cl-lib:fsqrt (* 2.0 (f2cl-lib:d1mach 3))))))
56
 
      (setf first f2cl-lib:%false%)
 
51
        (first$
 
52
         (setf nterf
 
53
                 (initds erfcs 21
 
54
                  (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3)))))
 
55
         (setf xbig
 
56
                 (f2cl-lib:fsqrt
 
57
                  (- (f2cl-lib:flog (* sqrtpi (f2cl-lib:d1mach 3))))))
 
58
         (setf sqeps (f2cl-lib:fsqrt (* 2.0 (f2cl-lib:d1mach 3))))))
 
59
      (setf first$ f2cl-lib:%false%)
57
60
      (setf y (coerce (abs x) 'double-float))
58
61
      (if (> y 1.0) (go label20))
59
62
      (if (<= y sqeps) (setf derf (/ (* 2.0 x x) sqrtpi)))