?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
In documentation for lreduce and rreduce, supply second argument as an explicit list
[maxima.git] / src / numerical / slatec / dyairy.lisp
blobd7817283653c028dfdc29a461cb9ef5a09a09f09
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 $")
9
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))
16
17 (in-package :slatec)
18
19
20 (let ((n1 20)
21 (n2 19)
22 (n3 14)
23 (m1 18)
24 (m2 17)
25 (m3 12)
26 (n1d 21)
27 (n2d 20)
28 (n3d 19)
29 (n4d 14)
30 (m1d 19)
31 (m2d 18)
32 (m3d 17)
33 (m4d 12)
34 (fpi12 1.30899693899575)
35 (spi12 1.83259571459405)
36 (con1 0.666666666666667)
37 (con2 7.74148278841779)
38 (con3 0.364766105490356)
39 (bk1
40 (make-array 20
41 :element-type 'double-float
42 :initial-contents '(2.43202846447449 2.57132009754685
43 1.02802341258616 0.341958178205872
44 0.0841978629889284 0.0193877282587962
45 0.00392687837130335 6.83302689948043e-4
46 1.14611403991141e-4 1.74195138337086e-5
47 2.41223620956355e-6 3.24525591983273e-7
48 4.03509798540183e-8 4.70875059642296e-9
49 5.35367432585889e-10
50 5.70606721846334e-11
51 5.80526363709933e-12
52 5.76338988616388e-13
53 5.42103834518071e-14
54 4.91857330301677e-15)))
55 (bk2
56 (make-array 20
57 :element-type 'double-float
58 :initial-contents '(0.574830555784088 -0.00691648648376891
59 0.00197460263052093 -5.24043043868823e-4
60 1.22965147239661e-4 -2.27059514462173e-5
61 2.23575555008526e-6 4.15174955023899e-7
62 -2.84985752198231e-7 8.50187174775435e-8
63 -1.70400826891326e-8 2.25479746746889e-9
64 -1.09524166577443e-10
65 -3.41063845099711e-11
66 1.11262893886662e-11
67 -1.75542944241734e-12
68 1.36298600401767e-13
69 8.76342105755664e-15
70 -4.64063099157041e-15
71 7.7877275873296e-16)))
72 (bk3
73 (make-array 20
74 :element-type 'double-float
75 :initial-contents '(0.566777053506912 0.00263672828349579
76 5.1230335147313e-5 2.10229231564492e-6
77 1.4221709511389e-7 1.28534295891264e-8
78 7.28556219407507e-10
79 -3.45236157301011e-10
80 -2.11919115912724e-10
81 -6.56803892922376e-11
82 -8.14873160315074e-12
83 3.03177845632183e-12
84 1.73447220554115e-12
85 1.67935548701554e-13
86 -1.49622868806719e-13
87 -5.15470458953407e-14
88 8.7574184185783e-15 7.9673555352572e-15
89 -1.29566137861742e-16
90 -1.1187879441752e-15)))
91 (bk4
92 (make-array 14
93 :element-type 'double-float
94 :initial-contents '(0.485444386705114 -0.00308525088408463
95 6.98748404837928e-5 -2.82757234179768e-6
96 1.59553313064138e-7 -1.12980692144601e-8
97 9.47671515498754e-10
98 -9.08301736026423e-11
99 9.70776206450724e-12
100 -1.13687527254574e-12
101 1.43982917533415e-13
102 -1.95211019558815e-14
103 2.81056379909357e-15
104 -4.26916444775176e-16)))
105 (bjp
106 (make-array 19
107 :element-type 'double-float
108 :initial-contents '(0.134918611457638 -0.319314588205813
109 0.0522061946276114 0.0528869112170312
110 -0.0085810075607735 -0.00299211002025555
111 4.21126741969759e-4 8.73931830369273e-5
112 -1.06749163477533e-5
113 -1.56575097259349e-6 1.68051151983999e-7
114 1.89901103638691e-8 -1.81374004961922e-9
115 -1.66339134593739e-10
116 1.4295633578081e-11 1.10179811626595e-12
117 -8.60187724192263e-14
118 -5.71248177285064e-15
119 4.08414552853803e-16)))
120 (bjn
121 (make-array 19
122 :element-type 'double-float
123 :initial-contents '(0.0659041673525697 -0.424905910566004
124 0.28720974519583 0.129787771099606
125 -0.0456354317590358 -0.010263017598254
126 0.00250704671521101 3.78127183743483e-4
127 -7.11287583284084e-5
128 -8.08651210688923e-6 1.23879531273285e-6
129 1.13096815867279e-7 -1.4623428317631e-8
130 -1.11576315688077e-9
131 1.24846618243897e-10
132 8.18334132555274e-12
133 -8.07174877048484e-13
134 -4.63778618766425e-14
135 4.09043399081631e-15)))
136 (aa
137 (make-array 14
138 :element-type 'double-float
139 :initial-contents '(-0.278593552803079 0.00352915691882584
140 2.31149677384994e-5 -4.7131784226356e-6
141 1.12415907931333e-7 2.00100301184339e-8
142 -2.60948075302193e-9
143 3.55098136101216e-11
144 3.50849978423875e-11
145 -5.83007187954202e-12
146 2.04644828753326e-13
147 1.10529179476742e-13
148 -2.87724778038775e-14
149 2.88205111009939e-15)))
150 (bb
151 (make-array 14
152 :element-type 'double-float
153 :initial-contents '(-0.490275424742791 -0.00157647277946204
154 9.66195963140306e-5 -1.35916080268815e-7
155 -2.98157342654859e-7 1.86824767559979e-8
156 1.03685737667141e-9
157 -3.28660818434328e-10
158 2.5709141063278e-11 2.32357655300677e-12
159 -9.57523279048255e-13
160 1.20340828049719e-13
161 2.90907716770715e-15
162 -4.55656454580149e-15)))
163 (dbk1
164 (make-array 21
165 :element-type 'double-float
166 :initial-contents '(2.95926143981893 3.86774568440103
167 1.80441072356289 0.578070764125328
168 0.163011468174708 0.0392044409961855
169 0.00790964210433812 0.00150640863167338
170 2.56651976920042e-4 3.93826605867715e-5
171 5.81097771463818e-6 7.86881233754659e-7
172 9.93272957325739e-8 1.21424205575107e-8
173 1.38528332697707e-9 1.50190067586758e-10
174 1.58271945457594e-11
175 1.57531847699042e-12
176 1.50774055398181e-13
177 1.40594335806564e-14
178 1.24942698777218e-15)))
179 (dbk2
180 (make-array 20
181 :element-type 'double-float
182 :initial-contents '(0.549756809432471 0.00913556983276901
183 -0.00253635048605507 6.60423795342054e-4
184 -1.55217243135416e-4 3.00090325448633e-5
185 -3.76454339467348e-6
186 -1.33291331611616e-7 2.42587371049013e-7
187 -8.07861075240228e-8 1.71092818861193e-8
188 -2.41087357570599e-9
189 1.53910848162371e-10 2.5646537319063e-11
190 -9.88581911653212e-12
191 1.60877986412631e-12
192 -1.20952524741739e-13
193 -1.0697827841082e-14
194 5.02478557067561e-15
195 -8.68986130935886e-16)))
196 (dbk3
197 (make-array 20
198 :element-type 'double-float
199 :initial-contents '(0.560598509354302 -0.00364870013248135
200 -5.98147152307417e-5
201 -2.33611595253625e-6
202 -1.64571516521436e-7
203 -2.06333012920569e-8 -4.2774543157311e-9
204 -1.08494137799276e-9
205 -2.37207188872763e-10
206 -2.22132920864966e-11
207 1.07238008032138e-11
208 5.71954845245808e-12
209 7.51102737777835e-13
210 -3.81912369483793e-13
211 -1.75870057119257e-13
212 6.69641694419084e-15
213 2.26866724792055e-14
214 2.69898141356743e-15
215 -2.67133612397359e-15
216 -6.54121403165269e-16)))
217 (dbk4
218 (make-array 14
219 :element-type 'double-float
220 :initial-contents '(0.493072999188036 0.00438335419803815
221 -8.37413882246205e-5 3.20268810484632e-6
222 -1.7566197954827e-7 1.22269906524508e-8
223 -1.01381314366052e-9
224 9.63639784237475e-11
225 -1.02344993379648e-11
226 1.19264576554355e-12
227 -1.50443899103287e-13
228 2.03299052379349e-14
229 -2.91890652008292e-15
230 4.42322081975475e-16)))
231 (dbjp
232 (make-array 19
233 :element-type 'double-float
234 :initial-contents '(0.113140872390745 -0.208301511416328
235 0.0169396341953138 0.0290895212478621
236 -0.00341467131311549
237 -0.00146455339197417 1.63313272898517e-4
238 3.91145328922162e-5 -3.96757190808119e-6
239 -6.51846913772395e-7 5.9870749526928e-8
240 7.44108654536549e-9
241 -6.21241056522632e-10
242 -6.18768017313526e-11
243 4.72323484752324e-12
244 3.91652459802532e-13
245 -2.74985937845226e-14
246 -1.9503649776275e-15
247 1.26669643809444e-16)))
248 (dbjn
249 (make-array 19
250 :element-type 'double-float
251 :initial-contents '(-0.018809126006885 -0.14779818082614
252 0.546075900433171 0.152146932663116
253 -0.0958260412266886 -0.016310273169613
254 0.00575364806680105 7.12145408252655e-4
255 -1.75452116846724e-4
256 -1.71063171685128e-5 3.2443558063168e-6
257 2.61190663932884e-7 -4.03026865912779e-8
258 -2.76435165853895e-9
259 3.59687929062312e-10
260 2.14953308456051e-11
261 -2.41849311903901e-12
262 -1.28068004920751e-13
263 1.26939834401773e-14)))
264 (daa
265 (make-array 14
266 :element-type 'double-float
267 :initial-contents '(0.277571356944231 -0.0044421283341992
268 8.42328522190089e-5 2.5804031841871e-6
269 -3.42389720217621e-7 6.24286894709776e-9
270 2.36377836844577e-9
271 -3.16991042656673e-10
272 4.40995691658191e-12
273 5.18674221093575e-12
274 -9.64874015137022e-13
275 4.9019057660871e-14 1.77253430678112e-14
276 -5.55950610442662e-15)))
277 (dbb
278 (make-array 14
279 :element-type 'double-float
280 :initial-contents '(0.491627321104601 0.00311164930427489
281 8.23140762854081e-5 -4.61769776172142e-6
282 -6.13158880534626e-8 2.8729580465652e-8
283 -1.81959715372117e-9
284 -1.44752826642035e-10
285 4.53724043420422e-11
286 -3.99655065847223e-12
287 -3.24089119830323e-13
288 1.62098952568741e-13
289 -2.40765247974057e-14
290 1.69384811284491e-16))))
291 (declare (type (f2cl-lib:integer4) n1 n2 n3 m1 m2 m3 n1d n2d n3d n4d m1d m2d
292 m3d m4d)
293 (type (double-float) fpi12 spi12 con1 con2 con3)
294 (type (simple-array double-float (20)) bk1 bk2 bk3 dbk2 dbk3)
295 (type (simple-array double-float (14)) bk4 aa bb dbk4 daa dbb)
296 (type (simple-array double-float (19)) bjp bjn dbjp dbjn)
297 (type (simple-array double-float (21)) dbk1))
298 (defun dyairy (x rx c bi dbi)
299 (declare (type (double-float) dbi bi c rx x))
300 (prog ((ax 0.0) (cv 0.0) (d1 0.0) (d2 0.0) (ex 0.0) (e1 0.0) (e2 0.0)
301 (f1 0.0) (f2 0.0) (rtrx 0.0) (s1 0.0) (s2 0.0) (t$ 0.0) (tc 0.0)
302 (temp1 0.0) (temp2 0.0) (tt 0.0) (i 0) (j 0))
303 (declare (type (f2cl-lib:integer4) j i)
304 (type (double-float) tt temp2 temp1 tc t$ s2 s1 rtrx f2 f1 e2 e1
305 ex d2 d1 cv ax))
306 (setf ax (abs x))
307 (setf rx (f2cl-lib:fsqrt ax))
308 (setf c (* con1 ax rx))
309 (if (< x 0.0) (go label120))
310 (if (> c 8.0) (go label60))
311 (if (> x 2.5) (go label30))
312 (setf t$ (* (- (+ x x) 2.5) 0.4))
313 (setf tt (+ t$ t$))
314 (setf j n1)
315 (setf f1 (f2cl-lib:fref bk1 (j) ((1 20))))
316 (setf f2 0.0)
317 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
318 ((> i m1) nil)
319 (tagbody
320 (setf j (f2cl-lib:int-sub j 1))
321 (setf temp1 f1)
322 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref bk1 (j) ((1 20)))))
323 (setf f2 temp1)
324 label10))
325 (setf bi (+ (- (* t$ f1) f2) (f2cl-lib:fref bk1 (1) ((1 20)))))
326 (setf j n1d)
327 (setf f1 (f2cl-lib:fref dbk1 (j) ((1 21))))
328 (setf f2 0.0)
329 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
330 ((> i m1d) nil)
331 (tagbody
332 (setf j (f2cl-lib:int-sub j 1))
333 (setf temp1 f1)
334 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref dbk1 (j) ((1 21)))))
335 (setf f2 temp1)
336 label20))
337 (setf dbi (+ (- (* t$ f1) f2) (f2cl-lib:fref dbk1 (1) ((1 21)))))
338 (go end_label)
339 label30
340 (setf rtrx (f2cl-lib:fsqrt rx))
341 (setf t$ (* (- (+ x x) con2) con3))
342 (setf tt (+ t$ t$))
343 (setf j n1)
344 (setf f1 (f2cl-lib:fref bk2 (j) ((1 20))))
345 (setf f2 0.0)
346 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
347 ((> i m1) nil)
348 (tagbody
349 (setf j (f2cl-lib:int-sub j 1))
350 (setf temp1 f1)
351 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref bk2 (j) ((1 20)))))
352 (setf f2 temp1)
353 label40))
354 (setf bi (/ (+ (- (* t$ f1) f2) (f2cl-lib:fref bk2 (1) ((1 20)))) rtrx))
355 (setf ex (exp c))
356 (setf bi (* bi ex))
357 (setf j n2d)
358 (setf f1 (f2cl-lib:fref dbk2 (j) ((1 20))))
359 (setf f2 0.0)
360 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
361 ((> i m2d) nil)
362 (tagbody
363 (setf j (f2cl-lib:int-sub j 1))
364 (setf temp1 f1)
365 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref dbk2 (j) ((1 20)))))
366 (setf f2 temp1)
367 label50))
368 (setf dbi
369 (* (+ (- (* t$ f1) f2) (f2cl-lib:fref dbk2 (1) ((1 20)))) rtrx))
370 (setf dbi (* dbi ex))
371 (go end_label)
372 label60
373 (setf rtrx (f2cl-lib:fsqrt rx))
374 (setf t$ (- (/ 16.0 c) 1.0))
375 (setf tt (+ t$ t$))
376 (setf j n1)
377 (setf f1 (f2cl-lib:fref bk3 (j) ((1 20))))
378 (setf f2 0.0)
379 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
380 ((> i m1) nil)
381 (tagbody
382 (setf j (f2cl-lib:int-sub j 1))
383 (setf temp1 f1)
384 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref bk3 (j) ((1 20)))))
385 (setf f2 temp1)
386 label70))
387 (setf s1 (+ (- (* t$ f1) f2) (f2cl-lib:fref bk3 (1) ((1 20)))))
388 (setf j n2d)
389 (setf f1 (f2cl-lib:fref dbk3 (j) ((1 20))))
390 (setf f2 0.0)
391 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
392 ((> i m2d) nil)
393 (tagbody
394 (setf j (f2cl-lib:int-sub j 1))
395 (setf temp1 f1)
396 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref dbk3 (j) ((1 20)))))
397 (setf f2 temp1)
398 label80))
399 (setf d1 (+ (- (* t$ f1) f2) (f2cl-lib:fref dbk3 (1) ((1 20)))))
400 (setf tc (+ c c))
401 (setf ex (exp c))
402 (if (> tc 35.0) (go label110))
403 (setf t$ (- (/ 10.0 c) 1.0))
404 (setf tt (+ t$ t$))
405 (setf j n3)
406 (setf f1 (f2cl-lib:fref bk4 (j) ((1 14))))
407 (setf f2 0.0)
408 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
409 ((> i m3) nil)
410 (tagbody
411 (setf j (f2cl-lib:int-sub j 1))
412 (setf temp1 f1)
413 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref bk4 (j) ((1 14)))))
414 (setf f2 temp1)
415 label90))
416 (setf s2 (+ (- (* t$ f1) f2) (f2cl-lib:fref bk4 (1) ((1 14)))))
417 (setf bi (/ (+ s1 (* (exp (- tc)) s2)) rtrx))
418 (setf bi (* bi ex))
419 (setf j n4d)
420 (setf f1 (f2cl-lib:fref dbk4 (j) ((1 14))))
421 (setf f2 0.0)
422 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
423 ((> i m4d) nil)
424 (tagbody
425 (setf j (f2cl-lib:int-sub j 1))
426 (setf temp1 f1)
427 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref dbk4 (j) ((1 14)))))
428 (setf f2 temp1)
429 label100))
430 (setf d2 (+ (- (* t$ f1) f2) (f2cl-lib:fref dbk4 (1) ((1 14)))))
431 (setf dbi (* rtrx (+ d1 (* (exp (- tc)) d2))))
432 (setf dbi (* dbi ex))
433 (go end_label)
434 label110
435 (setf bi (/ (* ex s1) rtrx))
436 (setf dbi (* ex rtrx d1))
437 (go end_label)
438 label120
439 (if (> c 5.0) (go label150))
440 (setf t$ (- (* 0.4 c) 1.0))
441 (setf tt (+ t$ t$))
442 (setf j n2)
443 (setf f1 (f2cl-lib:fref bjp (j) ((1 19))))
444 (setf e1 (f2cl-lib:fref bjn (j) ((1 19))))
445 (setf f2 0.0)
446 (setf e2 0.0)
447 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
448 ((> i m2) nil)
449 (tagbody
450 (setf j (f2cl-lib:int-sub j 1))
451 (setf temp1 f1)
452 (setf temp2 e1)
453 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref bjp (j) ((1 19)))))
454 (setf e1 (+ (- (* tt e1) e2) (f2cl-lib:fref bjn (j) ((1 19)))))
455 (setf f2 temp1)
456 (setf e2 temp2)
457 label130))
458 (setf bi
459 (- (+ (- (* t$ e1) e2) (f2cl-lib:fref bjn (1) ((1 19))))
460 (* ax (+ (- (* t$ f1) f2) (f2cl-lib:fref bjp (1) ((1 19)))))))
461 (setf j n3d)
462 (setf f1 (f2cl-lib:fref dbjp (j) ((1 19))))
463 (setf e1 (f2cl-lib:fref dbjn (j) ((1 19))))
464 (setf f2 0.0)
465 (setf e2 0.0)
466 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
467 ((> i m3d) nil)
468 (tagbody
469 (setf j (f2cl-lib:int-sub j 1))
470 (setf temp1 f1)
471 (setf temp2 e1)
472 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref dbjp (j) ((1 19)))))
473 (setf e1 (+ (- (* tt e1) e2) (f2cl-lib:fref dbjn (j) ((1 19)))))
474 (setf f2 temp1)
475 (setf e2 temp2)
476 label140))
477 (setf dbi
478 (+ (* x x (+ (- (* t$ f1) f2) (f2cl-lib:fref dbjp (1) ((1 19)))))
479 (+ (- (* t$ e1) e2) (f2cl-lib:fref dbjn (1) ((1 19))))))
480 (go end_label)
481 label150
482 (setf rtrx (f2cl-lib:fsqrt rx))
483 (setf t$ (- (/ 10.0 c) 1.0))
484 (setf tt (+ t$ t$))
485 (setf j n3)
486 (setf f1 (f2cl-lib:fref aa (j) ((1 14))))
487 (setf e1 (f2cl-lib:fref bb (j) ((1 14))))
488 (setf f2 0.0)
489 (setf e2 0.0)
490 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
491 ((> i m3) nil)
492 (tagbody
493 (setf j (f2cl-lib:int-sub j 1))
494 (setf temp1 f1)
495 (setf temp2 e1)
496 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref aa (j) ((1 14)))))
497 (setf e1 (+ (- (* tt e1) e2) (f2cl-lib:fref bb (j) ((1 14)))))
498 (setf f2 temp1)
499 (setf e2 temp2)
500 label160))
501 (setf temp1 (+ (- (* t$ f1) f2) (f2cl-lib:fref aa (1) ((1 14)))))
502 (setf temp2 (+ (- (* t$ e1) e2) (f2cl-lib:fref bb (1) ((1 14)))))
503 (setf cv (- c fpi12))
504 (setf bi (/ (+ (* temp1 (cos cv)) (* temp2 (sin cv))) rtrx))
505 (setf j n4d)
506 (setf f1 (f2cl-lib:fref daa (j) ((1 14))))
507 (setf e1 (f2cl-lib:fref dbb (j) ((1 14))))
508 (setf f2 0.0)
509 (setf e2 0.0)
510 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
511 ((> i m4d) nil)
512 (tagbody
513 (setf j (f2cl-lib:int-sub j 1))
514 (setf temp1 f1)
515 (setf temp2 e1)
516 (setf f1 (+ (- (* tt f1) f2) (f2cl-lib:fref daa (j) ((1 14)))))
517 (setf e1 (+ (- (* tt e1) e2) (f2cl-lib:fref dbb (j) ((1 14)))))
518 (setf f2 temp1)
519 (setf e2 temp2)
520 label170))
521 (setf temp1 (+ (- (* t$ f1) f2) (f2cl-lib:fref daa (1) ((1 14)))))
522 (setf temp2 (+ (- (* t$ e1) e2) (f2cl-lib:fref dbb (1) ((1 14)))))
523 (setf cv (- c spi12))
524 (setf dbi (* (- (* temp1 (cos cv)) (* temp2 (sin cv))) rtrx))
525 (go end_label)
526 end_label
527 (return (values nil rx c bi dbi)))))
528
529 (in-package #:cl-user)
530 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
531 (eval-when (:load-toplevel :compile-toplevel :execute)
532 (setf (gethash 'fortran-to-lisp::dyairy
533 fortran-to-lisp::*f2cl-function-info*)
534 (fortran-to-lisp::make-f2cl-finfo
535 :arg-types '((double-float) (double-float) (double-float)
536 (double-float) (double-float))
537 :return-values '(nil fortran-to-lisp::rx fortran-to-lisp::c
538 fortran-to-lisp::bi fortran-to-lisp::dbi)
539 :calls 'nil)))
540
Maxima, a Computer Algebra System