Don't use fname to define functions
[maxima.git] / src / numerical / slatec / dbesy0.lisp
blob78bf2563df443957a1db144aa098e316d5dc3dac
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)
11 ;;;
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))
17 (in-package :slatec)
20 (let ((nty0 0)
21 (xsml 0.0)
22 (by0cs
23 (make-array 19
24 :element-type 'double-float
25 :initial-contents '(-0.011277839392865573
26 -0.12834523756042035
27 -0.10437884799794249
28 0.023662749183969694
29 -0.002090391647700486
30 1.0397545393905725e-4
31 -3.369747162423972e-6
32 7.729384267670667e-8
33 -1.3249767726642596e-9
34 1.764823261540453e-11
35 -1.8810550715801962e-13
36 1.6418654853661494e-15
37 -1.1956594386046061e-17
38 7.377296297440186e-20
39 -3.9068434767104375e-22
40 1.795503664436158e-24
41 -7.22962712544801e-27
42 2.5717279316351685e-29
43 -8.141268814163695e-32)))
44 (twodpi 0.6366197723675814)
45 (first$ nil))
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%)
51 (defun dbesy0 (x)
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))
55 (cond
56 (first$
57 (setf nty0
58 (initds by0cs 19
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))
64 (setf y 0.0)
65 (if (> x xsml) (setf y (* x x)))
66 (setf dbesy0
67 (+ (* twodpi (f2cl-lib:flog (* 0.5 x)) (dbesj0 x))
68 0.375
69 (dcsevl (- (* 0.125 y) 1.0) by0cs nty0)))
70 (go end_label)
71 label20
72 (multiple-value-bind (var-0 var-1 var-2)
73 (d9b0mp x ampl theta)
74 (declare (ignore var-0))
75 (setf ampl var-1)
76 (setf theta var-2))
77 (setf dbesy0 (* ampl (sin theta)))
78 (go end_label)
79 end_label
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))
88 :return-values '(nil)
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))))