Menu
▾
▴
[Maxima-commits] CVS: maxima/src/numerical/slatec d9aimp.lisp,1.1,1.2 d9b0mp.lisp,1.1,1.2 d9b1mp.lisp,1.1,1.2 d9lgmc.lisp,1.1,1.2 dai.lisp,1.1,1.2 daie.lisp,1.1,1.2 dasyik.lisp,1.2,1.3 dasyjy.lisp,1.2,1.3 dbesi.lisp,1.2,1.3 dbesi0.lisp,1.1,1.2 dbesi1.lisp,1.1,1.2 dbesj.lisp,1.2,1.3 dbesj0.lisp,1.1,1.2 dbesj1.lisp,1.1,1.2 dbesy0.lisp,1.1,1.2 dbesy1.lisp,1.1,1.2 dbsi0e.lisp,1.1,1.2 dbsi1e.lisp,1.1,1.2 dcsevl.lisp,1.1,1.2 de1.lisp,1.1,1.2 dei.lisp,1.1,1.2 derf.lisp,1.1,1.2 derfc.lisp,1.1,1.2 dgamlm.lisp,1.1,1.2 dgamln.lisp,1.1,1.2 dgamma.lisp,1.1,1.2 djairy.lisp,1.1,1.2 dlngam.lisp,1.1,1.2 fdump.lisp,1.1,1.2 initds.lisp,1.1,1.2 j4save.lisp,1.1,1.2 xercnt.lisp,1.1,1.2 xerhlt.lisp,1.1,1.2 xermsg.lisp,1.1,1.2 xerprn.lisp,1.1,1.2 xersve.lisp,1.1,1.2 xgetua.lisp,1.1,1.2 zabs.lisp,1.1,1.2 zacai.lisp,1.1,1.2 zairy.lisp,1.1,1.2 zasyi.lisp,1.1,1.2 zbesj.lisp,1.1,1.2 zbinu.lisp,1.1,1.2 zbknu.lisp,1.1,1.2 zbuni.lisp,1.1,1.2 zdiv.lisp,1.1,1.2 zexp.lisp,1.1,1.2 zkscl.lisp,1.1,1.2 zlog.lisp,1.1,1.2 zmlri.lisp,1.1,1.2 zmlt.lisp,1.1,1.2 zrati.lisp,1.1,1.2 zs1s2.lisp,1.1,1.2 zseri.lisp,1.1,1.2 zshch.lisp,1.1,1.2 zsqrt.lisp,1.1,1.2 zuchk.lisp,1.1,1.2 zunhj.lisp,1.1,1.2 zuni1.lisp,1.1,1.2 zuni2.lisp,1.1,1.2 zunik.lisp,1.1,1.2 zuoik.lisp,1.1,1.2 zwrsk.lisp,1.1,1.2
Update of /cvsroot/maxima/maxima/src/numerical/slatec
In directory usw-pr-cvs1:/tmp/cvs-serv10044/src/numerical/slatec
Modified Files:
d9aimp.lisp d9b0mp.lisp d9b1mp.lisp d9lgmc.lisp dai.lisp
daie.lisp dasyik.lisp dasyjy.lisp dbesi.lisp dbesi0.lisp
dbesi1.lisp dbesj.lisp dbesj0.lisp dbesj1.lisp dbesy0.lisp
dbesy1.lisp dbsi0e.lisp dbsi1e.lisp dcsevl.lisp de1.lisp
dei.lisp derf.lisp derfc.lisp dgamlm.lisp dgamln.lisp
dgamma.lisp djairy.lisp dlngam.lisp fdump.lisp initds.lisp
j4save.lisp xercnt.lisp xerhlt.lisp xermsg.lisp xerprn.lisp
xersve.lisp xgetua.lisp zabs.lisp zacai.lisp zairy.lisp
zasyi.lisp zbesj.lisp zbinu.lisp zbknu.lisp zbuni.lisp
zdiv.lisp zexp.lisp zkscl.lisp zlog.lisp zmlri.lisp zmlt.lisp
zrati.lisp zs1s2.lisp zseri.lisp zshch.lisp zsqrt.lisp
zuchk.lisp zunhj.lisp zuni1.lisp zuni2.lisp zunik.lisp
zuoik.lisp zwrsk.lisp
Log Message:
Regenerated from latest version (2002-05-06) of f2cl.
Index: d9aimp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/d9aimp.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- d9aimp.lisp 26 Apr 2002 12:30:59 -0000 1.1
+++ d9aimp.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:25
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -413,118 +413,31 @@
(declare (type single-float eta) (type double-float z sqrtx))
(cond
(first (setf eta (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3))))
- (setf nam20
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds am20cs 57 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nath0
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds ath0cs 53 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nam21
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds am21cs 60 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nath1
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds ath1cs 58 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nam22
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds am22cs 74 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nath2
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds ath2cs 72 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
+ (setf nam20 (initds am20cs 57 eta))
+ (setf nath0 (initds ath0cs 53 eta))
+ (setf nam21 (initds am21cs 60 eta))
+ (setf nath1 (initds ath1cs 58 eta))
+ (setf nam22 (initds am22cs 74 eta))
+ (setf nath2 (initds ath2cs 72 eta))
(setf xsml (/ -1.0 (expt (f2cl-lib:d1mach 3) 0.3333)))))
(setf first f2cl-lib:%false%)
(if (>= x -4.0) (go label20))
(setf z 1.0)
(if (> x xsml) (setf z (+ (/ 128.0 (expt x 3)) 1.0)))
- (setf ampl
- (+ 0.3125
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z am20cs nam20)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nam20 var-2))
- ret-val)))
- (setf theta
- (-
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z ath0cs nath0)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nath0 var-2))
- ret-val)
- 0.625))
+ (setf ampl (+ 0.3125 (dcsevl z am20cs nam20)))
+ (setf theta (- (dcsevl z ath0cs nath0) 0.625))
(go label40)
label20
(if (>= x -2.0) (go label30))
(setf z (/ (+ (/ 128.0 (expt x 3)) 9.0) 7.0))
- (setf ampl
- (+ 0.3125
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z am21cs nam21)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nam21 var-2))
- ret-val)))
- (setf theta
- (-
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z ath1cs nath1)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nath1 var-2))
- ret-val)
- 0.625))
+ (setf ampl (+ 0.3125 (dcsevl z am21cs nam21)))
+ (setf theta (- (dcsevl z ath1cs nath1) 0.625))
(go label40)
label30
(if (>= x -1.0) (xermsg "SLATEC" "D9AIMP" "X MUST BE LE -1.0" 1 2))
(setf z (/ (+ (/ 16.0 (expt x 3)) 9.0) 7.0))
- (setf ampl
- (+ 0.3125
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z am22cs nam22)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nam22 var-2))
- ret-val)))
- (setf theta
- (-
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z ath2cs nath2)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nath2 var-2))
- ret-val)
- 0.625))
+ (setf ampl (+ 0.3125 (dcsevl z am22cs nam22)))
+ (setf theta (- (dcsevl z ath2cs nath2) 0.625))
label40
(setf sqrtx (f2cl-lib:fsqrt (- x)))
(setf ampl (f2cl-lib:fsqrt (/ ampl sqrtx)))
Index: d9b0mp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/d9b0mp.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- d9b0mp.lisp 26 Apr 2002 12:30:59 -0000 1.1
+++ d9b0mp.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:29
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -193,88 +193,24 @@
(declare (type single-float eta) (type double-float z))
(cond
(first (setf eta (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3))))
- (setf nbm0
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bm0cs 37 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nbt02
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bt02cs 39 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nbm02
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bm02cs 40 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nbth0
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bth0cs 44 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
+ (setf nbm0 (initds bm0cs 37 eta))
+ (setf nbt02 (initds bt02cs 39 eta))
+ (setf nbm02 (initds bm02cs 40 eta))
+ (setf nbth0 (initds bth0cs 44 eta))
(setf xmax (/ 1.0 (f2cl-lib:d1mach 4)))))
(setf first f2cl-lib:%false%)
(if (< x 4.0) (xermsg "SLATEC" "D9B0MP" "X MUST BE GE 4" 1 2))
(if (> x 8.0) (go label20))
(setf z (/ (- (/ 128.0 (* x x)) 5.0) 3.0))
- (setf ampl
- (/
- (+ 0.75
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bm0cs nbm0)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbm0 var-2))
- ret-val))
- (f2cl-lib:fsqrt x)))
- (setf theta
- (+ (- x pi4)
- (/
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bt02cs nbt02)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbt02 var-2))
- ret-val)
- x)))
+ (setf ampl (/ (+ 0.75 (dcsevl z bm0cs nbm0)) (f2cl-lib:fsqrt x)))
+ (setf theta (+ (- x pi4) (/ (dcsevl z bt02cs nbt02) x)))
(go end_label)
label20
(if (> x xmax)
(xermsg "SLATEC" "D9B0MP" "NO PRECISION BECAUSE X IS BIG" 2 2))
(setf z (- (/ 128.0 (* x x)) 1.0))
- (setf ampl
- (/
- (+ 0.75
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bm02cs nbm02)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbm02 var-2))
- ret-val))
- (f2cl-lib:fsqrt x)))
- (setf theta
- (+ (- x pi4)
- (/
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bth0cs nbth0)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbth0 var-2))
- ret-val)
- x)))
+ (setf ampl (/ (+ 0.75 (dcsevl z bm02cs nbm02)) (f2cl-lib:fsqrt x)))
+ (setf theta (+ (- x pi4) (/ (dcsevl z bth0cs nbth0) x)))
(go end_label)
end_label
(return (values nil ampl theta)))))
Index: d9b1mp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/d9b1mp.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- d9b1mp.lisp 26 Apr 2002 12:30:59 -0000 1.1
+++ d9b1mp.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:31
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -193,88 +193,24 @@
(declare (type single-float eta) (type double-float z))
(cond
(first (setf eta (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3))))
- (setf nbm1
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bm1cs 37 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nbt12
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bt12cs 39 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nbm12
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bm12cs 40 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf nbth1
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds bth1cs 44 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
+ (setf nbm1 (initds bm1cs 37 eta))
+ (setf nbt12 (initds bt12cs 39 eta))
+ (setf nbm12 (initds bm12cs 40 eta))
+ (setf nbth1 (initds bth1cs 44 eta))
(setf xmax (/ 1.0 (f2cl-lib:d1mach 4)))))
(setf first f2cl-lib:%false%)
(cond
((< x 4.0) (xermsg "SLATEC" "D9B1MP" "X must be >= 4" 1 2)
(setf ampl 0.0) (setf theta 0.0))
((<= x 8.0) (setf z (/ (- (/ 128.0 (* x x)) 5.0) 3.0))
- (setf ampl
- (/
- (+ 0.75
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bm1cs nbm1)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbm1 var-2))
- ret-val))
- (f2cl-lib:fsqrt x)))
- (setf theta
- (+ (- x (* 3.0 pi4))
- (/
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bt12cs nbt12)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbt12 var-2))
- ret-val)
- x))))
+ (setf ampl (/ (+ 0.75 (dcsevl z bm1cs nbm1)) (f2cl-lib:fsqrt x)))
+ (setf theta (+ (- x (* 3.0 pi4)) (/ (dcsevl z bt12cs nbt12) x))))
(t
(if (> x xmax)
(xermsg "SLATEC" "D9B1MP" "No precision because X is too big" 2 2))
(setf z (- (/ 128.0 (* x x)) 1.0))
- (setf ampl
- (/
- (+ 0.75
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bm12cs nbm12)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbm12 var-2))
- ret-val))
- (f2cl-lib:fsqrt x)))
- (setf theta
- (+ (- x (* 3.0 pi4))
- (/
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z bth1cs nbth1)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf nbth1 var-2))
- ret-val)
- x)))))
+ (setf ampl (/ (+ 0.75 (dcsevl z bm12cs nbm12)) (f2cl-lib:fsqrt x)))
+ (setf theta (+ (- x (* 3.0 pi4)) (/ (dcsevl z bth1cs nbth1) x)))))
(go end_label)
end_label
(return (values nil ampl theta)))))
Index: d9lgmc.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/d9lgmc.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- d9lgmc.lisp 26 Apr 2002 12:30:59 -0000 1.1
+++ d9lgmc.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:32
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -51,15 +51,8 @@
(setf d9lgmc (/ 1.0 (* 12.0 x)))
(if (< x xbig)
(setf d9lgmc
- (/
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl (- (* 2.0 (expt (/ 10.0 x) 2)) 1.0) algmcs
- nalgm)
- (declare (ignore var-0 var-1))
- (when var-2 (setf nalgm var-2))
- ret-val)
- x)))
+ (/ (dcsevl (- (* 2.0 (expt (/ 10.0 x) 2)) 1.0) algmcs nalgm)
+ x)))
(go end_label)
label20
(setf d9lgmc 0.0)
Index: dai.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/dai.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- dai.lisp 26 Apr 2002 12:30:59 -0000 1.1
+++ dai.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:33
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -71,10 +71,9 @@
(multiple-value-bind
(var-0 var-1 var-2)
(d9aimp x xm theta)
- (declare (ignore))
- (when var-0 (setf x var-0))
- (when var-1 (setf xm var-1))
- (when var-2 (setf theta var-2)))
+ (declare (ignore var-0))
+ (setf xm var-1)
+ (setf theta var-2))
(setf dai (* xm (cos theta)))
(go end_label)
label20
@@ -83,40 +82,17 @@
(if (> (abs x) x3sml) (setf z (expt x 3)))
(setf dai
(+ 0.375
- (-
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z aifcs naif)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf naif var-2))
- ret-val)
- (* x
- (+ 0.25
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z aigcs naig)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf naig var-2))
- ret-val))))))
+ (- (dcsevl z aifcs naif)
+ (* x (+ 0.25 (dcsevl z aigcs naig))))))
(go end_label)
label30
(if (> x xmax) (go label40))
- (setf dai
- (*
- (multiple-value-bind
- (ret-val var-0)
- (daie x)
- (declare (ignore))
- (when var-0 (setf x var-0))
- ret-val)
- (exp (/ (* -2.0 x (f2cl-lib:fsqrt x)) 3.0))))
+ (setf dai (* (daie x) (exp (/ (* -2.0 x (f2cl-lib:fsqrt x)) 3.0))))
(go end_label)
label40
(setf dai 0.0)
(xermsg "SLATEC" "DAI" "X SO BIG AI UNDERFLOWS" 1 1)
(go end_label)
end_label
- (return (values dai x)))))
+ (return (values dai nil)))))
Index: daie.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/daie.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- daie.lisp 26 Apr 2002 12:30:59 -0000 1.1
+++ daie.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:34
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -154,34 +154,10 @@
(type double-float daie z xm theta sqrtx))
(cond
(first (setf eta (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3))))
- (setf naif
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds aifcs 13 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf naig
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds aigcs 13 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf naip1
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds aip1cs 57 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
- (setf naip2
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (initds aip2cs 37 eta)
- (declare (ignore var-0 var-1))
- (when var-2 (setf eta var-2))
- ret-val))
+ (setf naif (initds aifcs 13 eta))
+ (setf naig (initds aigcs 13 eta))
+ (setf naip1 (initds aip1cs 57 eta))
+ (setf naip2 (initds aip2cs 37 eta))
(setf x3sml (coerce (expt eta 0.3333f0) 'double-float))
(setf x32sml (* 1.3104 (expt x3sml 2)))
(setf xbig (expt (f2cl-lib:d1mach 2) 0.6666))))
@@ -190,10 +166,9 @@
(multiple-value-bind
(var-0 var-1 var-2)
(d9aimp x xm theta)
- (declare (ignore))
- (when var-0 (setf x var-0))
- (when var-1 (setf xm var-1))
- (when var-2 (setf theta var-2)))
+ (declare (ignore var-0))
+ (setf xm var-1)
+ (setf theta var-2))
(setf daie (* xm (cos theta)))
(go end_label)
label20
@@ -202,23 +177,8 @@
(if (> (abs x) x3sml) (setf z (expt x 3)))
(setf daie
(+ 0.375
- (-
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z aifcs naif)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf naif var-2))
- ret-val)
- (* x
- (+ 0.25
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z aigcs naig)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf naig var-2))
- ret-val))))))
+ (- (dcsevl z aifcs naif)
+ (* x (+ 0.25 (dcsevl z aigcs naig))))))
(if (> x x32sml)
(setf daie (* daie (exp (/ (* 2.0 x (f2cl-lib:fsqrt x)) 3.0)))))
(go end_label)
@@ -227,33 +187,15 @@
(setf sqrtx (f2cl-lib:fsqrt x))
(setf z (/ (- (/ 16.0 (* x sqrtx)) 9.0) 7.0))
(setf daie
- (/
- (+ 0.28125
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z aip1cs naip1)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf naip1 var-2))
- ret-val))
- (f2cl-lib:fsqrt sqrtx)))
+ (/ (+ 0.28125 (dcsevl z aip1cs naip1)) (f2cl-lib:fsqrt sqrtx)))
(go end_label)
label40
(setf sqrtx (f2cl-lib:fsqrt x))
(setf z -1.0)
(if (< x xbig) (setf z (- (/ 16.0 (* x sqrtx)) 1.0)))
(setf daie
- (/
- (+ 0.28125
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl z aip2cs naip2)
- (declare (ignore var-1))
- (when var-0 (setf z var-0))
- (when var-2 (setf naip2 var-2))
- ret-val))
- (f2cl-lib:fsqrt sqrtx)))
+ (/ (+ 0.28125 (dcsevl z aip2cs naip2)) (f2cl-lib:fsqrt sqrtx)))
(go end_label)
end_label
- (return (values daie x)))))
+ (return (values daie nil)))))
Index: dasyik.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/dasyik.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- dasyik.lisp 26 Apr 2002 16:21:24 -0000 1.2
+++ dasyik.lisp 8 May 2002 13:34:34 -0000 1.3
@@ -1,8 +1,8 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/26 at 12:16:51
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
-;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
-;;; (:array-slicing t) (:declare-common nil)
+;;; (:coerce-assigns :as-needed) (:array-type ':array)
+;;; (:array-slicing nil) (:declare-common nil)
;;; (:float-format double-float))
(in-package "SLATEC")
@@ -10,8 +10,8 @@
(let ((con (make-array 2 :element-type 'double-float))
(c (make-array 65 :element-type 'double-float)))
- (declare (type (simple-array double-float (65)) c)
- (type (simple-array double-float (2)) con))
+ (declare (type (array double-float (65)) c)
+ (type (array double-float (2)) con))
(f2cl-lib:fset (f2cl-lib:fref con (1) ((1 2))) 0.3989422804014327)
(f2cl-lib:fset (f2cl-lib:fref con (2) ((1 2))) 1.2533141373155003)
(f2cl-lib:fset (f2cl-lib:fref c (1) ((1 65))) -0.208333333333333)
@@ -137,7 +137,7 @@
label30))
label40
(setf t_ (coerce (abs t_) 'double-float))
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (jn) ((1 t)) y-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (jn) ((1 *)) y-%offset%)
(* s2
coef
(f2cl-lib:fsqrt t_)
Index: dasyjy.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/dasyjy.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- dasyjy.lisp 26 Apr 2002 14:15:20 -0000 1.2
+++ dasyjy.lisp 8 May 2002 13:34:34 -0000 1.3
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/26 at 10:05:50
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':array)
@@ -604,9 +604,8 @@
(tau 0.0) (tb 0.0) (tfn 0.0) (tol 0.0) (t2 0.0) (xx 0.0) (z 0.0)
(z32 0.0) (i 0) (j 0) (jn 0) (jr 0) (ju 0) (k 0) (kb 0)
(klast 0) (kp1 0) (ks 0) (ksp1 0) (kstemp 0) (l 0) (lr 0)
- (lrp1 0) (iseta 0) (isetb 0) (t_ 0.0f0))
- (declare (type single-float t_)
- (type (array f2cl-lib:integer4 (5)) kmax)
+ (lrp1 0) (iseta 0) (isetb 0))
+ (declare (type (array f2cl-lib:integer4 (5)) kmax)
(type f2cl-lib:integer4 isetb iseta lrp1 lr l kstemp ksp1 ks
kp1 klast kb k ju jr jn j i)
(type (array double-float (10)) upol dr cr)
@@ -630,15 +629,15 @@
((> jn in) nil)
(tagbody
(setf xx (/ x fn))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (1) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (1) ((1 *)) wk-%offset%)
(- 1.0 (* xx xx)))
(setf abw2
(coerce
- (abs (f2cl-lib:fref wk-%data% (1) ((1 t)) wk-%offset%))
+ (abs (f2cl-lib:fref wk-%data% (1) ((1 *)) wk-%offset%))
'double-float))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (2) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (2) ((1 *)) wk-%offset%)
(f2cl-lib:fsqrt abw2))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (7) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (7) ((1 *)) wk-%offset%)
(expt fn con2))
(if (> abw2 0.2775) (go label80))
(setf sa 0.0)
@@ -666,44 +665,44 @@
(* sa
(f2cl-lib:fref wk-%data%
(1)
- ((1 t))
+ ((1 *))
wk-%offset%))
(f2cl-lib:fref gama (kb) ((1 26)))))
label30))
- (setf z (* (f2cl-lib:fref wk-%data% (1) ((1 t)) wk-%offset%) sa))
+ (setf z (* (f2cl-lib:fref wk-%data% (1) ((1 *)) wk-%offset%) sa))
(setf az (coerce (abs z) 'double-float))
(setf rtz (f2cl-lib:fsqrt az))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)
(* con1 az rtz))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%)
(*
- (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)
fn))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (5) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (5) ((1 *)) wk-%offset%)
(* rtz
(f2cl-lib:fref wk-%data%
(7)
- ((1 t))
+ ((1 *))
wk-%offset%)))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 *)) wk-%offset%)
(*
(-
(f2cl-lib:fref wk-%data%
(5)
- ((1 t))
+ ((1 *))
wk-%offset%))
(f2cl-lib:fref wk-%data%
(5)
- ((1 t))
+ ((1 *))
wk-%offset%)))
(if (<= z 0.0) (go label35))
- (if (> (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%) elim)
+ (if (> (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%) elim)
(go label75))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 *)) wk-%offset%)
(-
(f2cl-lib:fref wk-%data%
(6)
- ((1 t))
+ ((1 *))
wk-%offset%)))
label35
(setf phi (f2cl-lib:fsqrt (f2cl-lib:fsqrt (+ sa sa sa sa))))
@@ -719,7 +718,7 @@
(* sb
(f2cl-lib:fref wk-%data%
(1)
- ((1 t))
+ ((1 *))
wk-%offset%))
(f2cl-lib:fref beta (kb 1) ((1 26) (1 5)))))
label40))
@@ -749,7 +748,7 @@
(* sa
(f2cl-lib:fref wk-%data%
(1)
- ((1 t))
+ ((1 *))
wk-%offset%))
(f2cl-lib:fref alfa (kb ks) ((1 26) (1 4)))))
(setf sb
@@ -757,7 +756,7 @@
(* sb
(f2cl-lib:fref wk-%data%
(1)
- ((1 t))
+ ((1 *))
wk-%offset%))
(f2cl-lib:fref beta (kb ksp1) ((1 26) (1 5)))))
label50))
@@ -773,7 +772,7 @@
(* fn
(f2cl-lib:fref wk-%data%
(7)
- ((1 t))
+ ((1 *))
wk-%offset%))))
(go label160)
label75
@@ -783,57 +782,57 @@
(f2cl-lib:fset (f2cl-lib:fref upol (1) ((1 10))) 1.0)
(setf tau
(/ 1.0
- (f2cl-lib:fref wk-%data% (2) ((1 t)) wk-%offset%)))
+ (f2cl-lib:fref wk-%data% (2) ((1 *)) wk-%offset%)))
(setf t2
(/ 1.0
- (f2cl-lib:fref wk-%data% (1) ((1 t)) wk-%offset%)))
- (if (>= (f2cl-lib:fref wk-%data% (1) ((1 t)) wk-%offset%) 0.0)
+ (f2cl-lib:fref wk-%data% (1) ((1 *)) wk-%offset%)))
+ (if (>= (f2cl-lib:fref wk-%data% (1) ((1 *)) wk-%offset%) 0.0)
(go label90))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)
(coerce
(abs
(-
(f2cl-lib:fref wk-%data%
(2)
- ((1 t))
+ ((1 *))
wk-%offset%)
(atan
(f2cl-lib:fref wk-%data%
(2)
- ((1 t))
+ ((1 *))
wk-%offset%))))
'double-float))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%)
(*
- (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)
fn))
(setf rcz
(/ (- con1)
- (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%)))
+ (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%)))
(setf z32
(* 1.5
- (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)))
+ (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)))
(setf rtz (expt z32 con2))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (5) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (5) ((1 *)) wk-%offset%)
(* rtz
(f2cl-lib:fref wk-%data%
(7)
- ((1 t))
+ ((1 *))
wk-%offset%)))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 *)) wk-%offset%)
(*
(-
(f2cl-lib:fref wk-%data%
(5)
- ((1 t))
+ ((1 *))
wk-%offset%))
(f2cl-lib:fref wk-%data%
(5)
- ((1 t))
+ ((1 *))
wk-%offset%)))
(go label100)
label90
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)
(coerce
(abs
(-
@@ -842,41 +841,41 @@
(+ 1.0
(f2cl-lib:fref wk-%data%
(2)
- ((1 t))
+ ((1 *))
wk-%offset%))
xx))
(f2cl-lib:fref wk-%data%
(2)
- ((1 t))
+ ((1 *))
wk-%offset%)))
'double-float))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%)
(*
- (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)
fn))
(setf rcz
(/ con1
- (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%)))
- (if (> (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%) elim)
+ (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%)))
+ (if (> (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%) elim)
(go label75))
(setf z32
(* 1.5
- (f2cl-lib:fref wk-%data% (3) ((1 t)) wk-%offset%)))
+ (f2cl-lib:fref wk-%data% (3) ((1 *)) wk-%offset%)))
(setf rtz (expt z32 con2))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (7) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (7) ((1 *)) wk-%offset%)
(expt fn con2))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (5) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (5) ((1 *)) wk-%offset%)
(* rtz
(f2cl-lib:fref wk-%data%
(7)
- ((1 t))
+ ((1 *))
wk-%offset%)))
- (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 t)) wk-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref wk-%data% (6) ((1 *)) wk-%offset%)
(*
- (f2cl-lib:fref wk-%data% (5) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (5) ((1 *)) wk-%offset%)
(f2cl-lib:fref wk-%data%
(5)
- ((1 t))
+ ((1 *))
wk-%offset%)))
label100
(setf phi (f2cl-lib:fsqrt (* (+ rtz rtz) tau)))
@@ -952,7 +951,7 @@
label130))
(setf rden (* rden rfn2))
(setf tb (- tb))
- (if (> (f2cl-lib:fref wk-%data% (1) ((1 t)) wk-%offset%) 0.0)
+ (if (> (f2cl-lib:fref wk-%data% (1) ((1 *)) wk-%offset%) 0.0)
(setf tb (coerce (abs tb) 'double-float)))
(if (< rden tol) (go label131))
(setf asum (+ asum (* suma tb)))
@@ -970,31 +969,31 @@
(if (and (= iseta 1) (= isetb 1)) (go label150))
label140))
label150
- (setf tb (f2cl-lib:fref wk-%data% (5) ((1 t)) wk-%offset%))
- (if (> (f2cl-lib:fref wk-%data% (1) ((1 t)) wk-%offset%) 0.0)
+ (setf tb (f2cl-lib:fref wk-%data% (5) ((1 *)) wk-%offset%))
+ (if (> (f2cl-lib:fref wk-%data% (1) ((1 *)) wk-%offset%) 0.0)
(setf tb (- tb)))
(setf bsum (/ bsum tb))
label160
(multiple-value-bind
(var-0 var-1 var-2 var-3 var-4)
(funcall funjy
- (f2cl-lib:fref wk-%data% (6) ((1 t)) wk-%offset%)
- (f2cl-lib:fref wk-%data% (5) ((1 t)) wk-%offset%)
- (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (6) ((1 *)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (5) ((1 *)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%)
fi
dfi)
(declare (ignore))
(when var-0
(f2cl-lib:fset
- (f2cl-lib:fref wk-%data% (6) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (6) ((1 *)) wk-%offset%)
var-0))
(when var-1
(f2cl-lib:fset
- (f2cl-lib:fref wk-%data% (5) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (5) ((1 *)) wk-%offset%)
var-1))
(when var-2
(f2cl-lib:fset
- (f2cl-lib:fref wk-%data% (4) ((1 t)) wk-%offset%)
+ (f2cl-lib:fref wk-%data% (4) ((1 *)) wk-%offset%)
var-2))
(when var-3 (setf fi var-3))
(when var-4 (setf dfi var-4)))
@@ -1005,11 +1004,11 @@
(setf dfi (* dfi ta))
(setf phi (* phi tol))
label165
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (jn) ((1 t)) y-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (jn) ((1 *)) y-%offset%)
(/ (* flgjy phi (+ (* fi asum) (* dfi bsum)))
(f2cl-lib:fref wk-%data%
(7)
- ((1 t))
+ ((1 *))
wk-%offset%)))
(setf fn (- fn flgjy))
label170))
Index: dbesi.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/dbesi.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- dbesi.lisp 26 Apr 2002 16:20:55 -0000 1.2
+++ dbesi.lisp 8 May 2002 13:34:34 -0000 1.3
@@ -1,7 +1,7 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/26 at 12:17:13
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
-;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
+;;; (:coerce-assigns :as-needed) (:array-type ':array)
;;; (:array-slicing t) (:declare-common nil)
;;; (:float-format double-float))
@@ -27,7 +27,7 @@
(t2 0.0) (xo2 0.0) (xo2l 0.0) (z 0.0) (i 0) (ialp 0) (in 0) (is 0)
(i1 0) (k 0) (kk 0) (km 0) (kt 0) (nn 0) (ns 0) (t_ 0.0))
(declare (type f2cl-lib:integer4 ns nn kt km kk k i1 is in ialp i)
- (type (simple-array double-float (3)) temp)
+ (type (array double-float (3)) temp)
(type double-float t_ z xo2l xo2 t2 trx tol tm tfn tb ta s2 s1
sxo2 sx s ra gln fnu fnp1 fni fnf fn flgik etx elim earg dx
dtm dfn tolln atol arg ap ans akm ak ain))
@@ -54,7 +54,7 @@
label30
(f2cl-lib:arithmetic-if alpha (go label580) (go label40) (go label50))
label40
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (1) ((1 t)) y-%offset%) 1.0)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (1) ((1 *)) y-%offset%) 1.0)
(if (= n 1) (go end_label))
(setf i1 2)
(go label60)
@@ -64,7 +64,7 @@
(f2cl-lib:fdo (i i1 (f2cl-lib:int-add i 1))
((> i n) nil)
(tagbody
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (i) ((1 t)) y-%offset%) 0.0)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%) 0.0)
label70))
(go end_label)
label80
@@ -142,7 +142,7 @@
(go label130)
label160
(if (/= km 0) (go label170))
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (1) ((1 t)) y-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (1) ((1 *)) y-%offset%)
(f2cl-lib:fref temp (3) ((1 3))))
(go end_label)
label170
@@ -170,23 +170,12 @@
(var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
(dasyik x fn kode flgik ra arg i1
(f2cl-lib:array-slice temp double-float (is) ((1 3))))
- (declare (ignore var-7))
- (when var-0 (setf x var-0))
- (when var-1 (setf fn var-1))
- (when var-2 (setf kode var-2))
- (when var-3 (setf flgik var-3))
- (when var-4 (setf ra var-4))
- (when var-5 (setf arg var-5))
- (when var-6 (setf i1 var-6)))
+ (declare (ignore var-0 var-1 var-2 var-3 var-6 var-7))
+ (setf ra var-4)
+ (setf arg var-5))
(f2cl-lib:computed-goto (label180 label350 label510) is)
label230
- (setf gln
- (multiple-value-bind
- (ret-val var-0)
- (dlngam fnp1)
- (declare (ignore))
- (when var-0 (setf fnp1 var-0))
- ret-val))
+ (setf gln (dlngam fnp1))
(setf arg (- (* fn xo2l) gln sx))
(if (< arg (- elim)) (go label300))
(setf earg (exp arg))
@@ -219,7 +208,7 @@
(setf is 2)
(go label240)
label280
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 t)) y-%offset%) 0.0)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 *)) y-%offset%) 0.0)
(setf nn (f2cl-lib:int-sub nn 1))
(setf fni (- fni 1.0))
(setf dfn (+ fni fnf))
@@ -233,7 +222,7 @@
(setf is 2)
(go label130)
label300
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 t)) y-%offset%) 0.0)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 *)) y-%offset%) 0.0)
(setf nn (f2cl-lib:int-sub nn 1))
(setf fnp1 fn)
(setf fni (- fni 1.0))
@@ -275,17 +264,17 @@
(setf dtm (- dtm 1.0))
(setf tm (* (+ dtm fnf) trx))
label380))
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 t)) y-%offset%) s1)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 *)) y-%offset%) s1)
(if (= nn 1) (go end_label))
(f2cl-lib:fset
- (f2cl-lib:fref y-%data% ((f2cl-lib:int-sub nn 1)) ((1 t)) y-%offset%)
+ (f2cl-lib:fref y-%data% ((f2cl-lib:int-sub nn 1)) ((1 *)) y-%offset%)
s2)
(if (= nn 2) (go end_label))
(go label400)
label390
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 t)) y-%offset%) s1)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 *)) y-%offset%) s1)
(f2cl-lib:fset
- (f2cl-lib:fref y-%data% ((f2cl-lib:int-sub nn 1)) ((1 t)) y-%offset%)
+ (f2cl-lib:fref y-%data% ((f2cl-lib:int-sub nn 1)) ((1 *)) y-%offset%)
s2)
(if (= nn 2) (go end_label))
label400
@@ -297,21 +286,21 @@
(f2cl-lib:fset
(f2cl-lib:fref y-%data%
((f2cl-lib:int-sub k 2))
- ((1 t))
+ ((1 *))
y-%offset%)
(+
(* tm
(f2cl-lib:fref y-%data%
((f2cl-lib:int-sub k 1))
- ((1 t))
+ ((1 *))
y-%offset%))
- (f2cl-lib:fref y-%data% (k) ((1 t)) y-%offset%)))
+ (f2cl-lib:fref y-%data% (k) ((1 *)) y-%offset%)))
(setf dtm (- dtm 1.0))
(setf tm (* (+ dtm fnf) trx))
label410))
(go end_label)
label420
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (1) ((1 t)) y-%offset%)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (1) ((1 *)) y-%offset%)
(f2cl-lib:fref temp (2) ((1 3))))
(go end_label)
label430
@@ -407,12 +396,12 @@
(setf in ns)
(if (/= ns 0) (go label530))
label550
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 t)) y-%offset%) tb)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (nn) ((1 *)) y-%offset%) tb)
(setf nz (f2cl-lib:int-sub n nn))
(if (= nn 1) (go end_label))
(setf tb (+ (* tm tb) ta))
(setf k (f2cl-lib:int-sub nn 1))
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (k) ((1 t)) y-%offset%) tb)
+ (f2cl-lib:fset (f2cl-lib:fref y-%data% (k) ((1 *)) y-%offset%) tb)
(if (= nn 2) (go end_label))
(setf dtm (- dtm 1.0))
(setf tm (* (+ dtm fnf) trx))
@@ -423,12 +412,12 @@
(f2cl-lib:fset
(f2cl-lib:fref y-%data%
((f2cl-lib:int-sub k 1))
- ((1 t))
+ ((1 *))
y-%offset%)
- (+ (* tm (f2cl-lib:fref y-%data% (k) ((1 t)) y-%offset%))
+ (+ (* tm (f2cl-lib:fref y-%data% (k) ((1 *)) y-%offset%))
(f2cl-lib:fref y-%data%
((f2cl-lib:int-add k 1))
- ((1 t))
+ ((1 *))
y-%offset%)))
(setf dtm (- dtm 1.0))
(setf tm (* (+ dtm fnf) trx))
@@ -451,5 +440,5 @@
(xermsg "SLATEC" "DBESI" "OVERFLOW, X TOO LARGE FOR KODE = 1." 6 1)
(go end_label)
end_label
- (return (values x nil kode nil nil nz))))))
+ (return (values nil nil nil nil nil nz))))))
Index: dbesi0.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/dbesi0.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- dbesi0.lisp 26 Apr 2002 12:31:33 -0000 1.1
+++ dbesi0.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:44
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -52,27 +52,13 @@
(if (> y 3.0) (go label20))
(setf dbesi0 1.0)
(if (> y xsml)
- (setf dbesi0
- (+ 2.75
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl (- (/ (* y y) 4.5) 1.0) bi0cs nti0)
- (declare (ignore var-0 var-1))
- (when var-2 (setf nti0 var-2))
- ret-val))))
+ (setf dbesi0 (+ 2.75 (dcsevl (- (/ (* y y) 4.5) 1.0) bi0cs nti0))))
(go end_label)
label20
(if (> y xmax)
(xermsg "SLATEC" "DBESI0" "ABS(X) SO BIG I0 OVERFLOWS" 2 2))
- (setf dbesi0
- (* (exp y)
- (multiple-value-bind
- (ret-val var-0)
- (dbsi0e x)
- (declare (ignore))
- (when var-0 (setf x var-0))
- ret-val)))
+ (setf dbesi0 (* (exp y) (dbsi0e x)))
(go end_label)
end_label
- (return (values dbesi0 x)))))
+ (return (values dbesi0 nil)))))
Index: dbesi1.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/dbesi1.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- dbesi1.lisp 26 Apr 2002 12:31:33 -0000 1.1
+++ dbesi1.lisp 8 May 2002 13:34:34 -0000 1.2
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/25 at 13:18:45
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -58,27 +58,13 @@
(if (> y xmin) (setf dbesi1 (* 0.5 x)))
(if (> y xsml)
(setf dbesi1
- (* x
- (+ 0.875
- (multiple-value-bind
- (ret-val var-0 var-1 var-2)
- (dcsevl (- (/ (* y y) 4.5) 1.0) bi1cs nti1)
- (declare (ignore var-0 var-1))
- (when var-2 (setf nti1 var-2))
- ret-val)))))
+ (* x (+ 0.875 (dcsevl (- (/ (* y y) 4.5) 1.0) bi1cs nti1)))))
(go end_label)
label20
(if (> y xmax)
(xermsg "SLATEC" "DBESI1" "ABS(X) SO BIG I1 OVERFLOWS" 2 2))
- (setf dbesi1
- (* (exp y)
- (multiple-value-bind
- (ret-val var-0)
- (dbsi1e x)
- (declare (ignore))
- (when var-0 (setf x var-0))
- ret-val)))
+ (setf dbesi1 (* (exp y) (dbsi1e x)))
(go end_label)
end_label
- (return (values dbesi1 x)))))
+ (return (values dbesi1 nil)))))
Index: dbesj.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/numerical/slatec/dbesj.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- dbesj.lisp 26 Apr 2002 14:16:06 -0000 1.2
+++ dbesj.lisp 8 May 2002 13:34:34 -0000 1.3
@@ -1,4 +1,4 @@
-;;; Compiled by f2cl version 2.0 beta on 2002/04/26 at 09:38:37
+;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;;
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;; (:coerce-assigns :as-needed) (:array-type ':simple-array)
@@ -29,499 +29,473 @@
(declare (type double-float x alpha)
(type (array double-float (*)) y)
(type f2cl-lib:integer4 n nz))
- (f2cl-lib:with-array-data (y-%data% y-%offset% y)
- (declare (type f2cl-lib:integer4 y-%offset%)
- (type (simple-array double-float (*)) y-%data%)
- (ignorable y-%offset% y-%data%))
- (prog ((temp (make-array 3 :element-type 'double-float))
- (wk (make-array 7 :element-type 'double-float)) (ak 0.0) (akm 0.0)
- (ans 0.0) (ap 0.0) (arg 0.0) (coef 0.0) (dalpha 0.0) (dfn 0.0)
- (dtm 0.0) (earg 0.0) (elim1 0.0) (etx 0.0) (fidal 0.0) (flgjy 0.0)
- (fn 0.0) (fnf 0.0) (fni 0.0) (fnp1 0.0) (fnu 0.0) (gln 0.0)
- (rden 0.0) (relb 0.0) (rtx 0.0) (rzden 0.0) (s 0.0) (sa 0.0)
- (sb 0.0) (sxo2 0.0) (s1 0.0) (s2 0.0) (ta 0.0) (tau 0.0) (tb 0.0)
- (tfn 0.0) (tm 0.0) (tol 0.0) (tolln 0.0) (trx 0.0) (tx 0.0)
- (t1 0.0) (t2 0.0) (xo2 0.0) (xo2l 0.0) (slim 0.0) (rtol 0.0) (i 0)
- (ialp 0) (idalp 0) (iflw 0) (in 0) (is 0) (i1 0) (i2 0) (k 0)
- (kk 0) (km 0) (kt 0) (nn 0) (ns 0) (t_ 0.0))
- (declare
- (type f2cl-lib:integer4 ns nn kt km kk k i2 i1 is in iflw idalp ialp
- i)
- (type (simple-array double-float (7)) wk)
- (type (simple-array double-float (3)) temp)
- (type double-float t_ rtol slim xo2l xo2 t2 t1 tx trx tolln tol tm tfn
- tb tau ta s2 s1 sxo2 sb sa s rzden rtx relb rden gln fnu fnp1 fni fnf
- fn flgjy fidal etx elim1 earg dtm dfn dalpha coef arg ap ans akm ak))
- (setf nz 0)
- (setf kt 1)
- (setf ns 0)
- (setf ta (f2cl-lib:d1mach 3))
- (setf tol (max ta 1.0000000000000002e-15))
- (setf i1 (f2cl-lib:int-add (f2cl-lib:i1mach 14) 1))
- (setf i2 (f2cl-lib:i1mach 15))
- (setf tb (f2cl-lib:d1mach 5))
- (setf elim1 (* -2.303 (+ (* i2 tb) 3.0)))
- (setf rtol (/ 1.0 tol))
- (setf slim (* (f2cl-lib:d1mach 1) rtol 1000.0))
- (setf tolln (* 2.303 tb i1))
- (setf tolln (min tolln 34.5388))
- (f2cl-lib:arithmetic-if (f2cl-lib:int-sub n 1)
- (go label720)
- (go label10)
- (go label20))
- label10
- (setf kt 2)
- label20
- (setf nn n)
- (f2cl-lib:arithmetic-if x (go label730) (go label30) (go label80))
- label30
- (f2cl-lib:arithmetic-if alpha (go label710) (go label40) (go label50))
- label40
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (1) ((1 t)) y-%offset%) 1.0)
- (if (= n 1) (go end_label))
- (setf i1 2)
- (go label60)
- label50
- (setf i1 1)
- label60
- (f2cl-lib:fdo (i i1 (f2cl-lib:int-add i 1))
- ((> i n) nil)
- (tagbody
- (f2cl-lib:fset (f2cl-lib:fref y-%data% (i) ((1 t)) y-%offset%) 0.0)
- label70))
- (go end_label)
- label80
- (if (< alpha 0.0) (go label710))
- (setf ialp (f2cl-lib:int alpha))
- (setf fni
- (coerce
- (the f2cl-lib...
[truncated message content] |