1 ;;; Compiled by f2cl version:
2 ;;; ("f2cl1.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $"
3 ;;; "f2cl2.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
4 ;;; "f2cl3.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
5 ;;; "f2cl4.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
6 ;;; "f2cl5.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $"
7 ;;; "f2cl6.l,v 1d5cbacbb977 2008/08/24 00:56:27 rtoy $"
8 ;;; "macros.l,v fceac530ef0c 2011/11/26 04:02:26 toy $")
10 ;;; Using Lisp CMU Common Lisp snapshot-2012-04 (20C Unicode)
12 ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
13 ;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
14 ;;; (:array-slicing nil) (:declare-common nil)
15 ;;; (:float-format double-float))
24 :element-type
'double-float
25 :initial-contents
'(-0.011277839392865573
33 -
1.3249767726642596e-9
35 -
1.8810550715801962e-13
36 1.6418654853661494e-15
37 -
1.1956594386046061e-17
39 -
3.9068434767104375e-22
42 2.5717279316351685e-29
43 -
8.141268814163695e-32)))
44 (twodpi 0.6366197723675814)
46 (declare (type (f2cl-lib:integer4
) nty0
)
47 (type (double-float) xsml twodpi
)
48 (type (simple-array double-float
(19)) by0cs
)
49 (type f2cl-lib
:logical first$
))
50 (setq first$ f2cl-lib
:%true%
)
52 (declare (type (double-float) x
))
53 (prog ((ampl 0.0) (theta 0.0) (y 0.0) (dbesy0 0.0))
54 (declare (type (double-float) dbesy0 y theta ampl
))
59 (* 0.1f0
(f2cl-lib:freal
(f2cl-lib:d1mach
3)))))
60 (setf xsml
(f2cl-lib:fsqrt
(* 4.0 (f2cl-lib:d1mach
3))))))
61 (setf first$ f2cl-lib
:%false%
)
62 (if (<= x
0.0) (xermsg "SLATEC" "DBESY0" "X IS ZERO OR NEGATIVE" 1 2))
63 (if (> x
4.0) (go label20
))
65 (if (> x xsml
) (setf y
(* x x
)))
67 (+ (* twodpi
(f2cl-lib:flog
(* 0.5 x
)) (dbesj0 x
))
69 (dcsevl (- (* 0.125 y
) 1.0) by0cs nty0
)))
72 (multiple-value-bind (var-0 var-1 var-2
)
74 (declare (ignore var-0
))
77 (setf dbesy0
(* ampl
(sin theta
)))
80 (return (values dbesy0 nil
)))))
82 (in-package #:cl-user
)
83 #+#.
(cl:if
(cl:find-package
'#:f2cl
) '(and) '(or))
84 (eval-when (:load-toplevel
:compile-toplevel
:execute
)
85 (setf (gethash 'fortran-to-lisp
::dbesy0
86 fortran-to-lisp
::*f2cl-function-info
*)
87 (fortran-to-lisp::make-f2cl-finfo
:arg-types
'((double-float))
89 :calls
'(fortran-to-lisp::d9b0mp
90 fortran-to-lisp
::dcsevl
91 fortran-to-lisp
::dbesj0
92 fortran-to-lisp
::xermsg
93 fortran-to-lisp
::initds
94 fortran-to-lisp
::d1mach
))))