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 ':array)
14;;;           (:array-slicing t) (:declare-common nil)
15;;;           (:float-format double-float))
16
17(in-package :slatec)
18
19
20(defun dqcheb (x fval cheb12 cheb24)
21  (declare (type (array double-float (*)) cheb12)
22           (type (array double-float (*)) cheb24 fval)
23           (type (array double-float (*)) x))
24  (f2cl-lib:with-multi-array-data
25      ((x double-float x-%data% x-%offset%)
26       (fval double-float fval-%data% fval-%offset%)
27       (cheb24 double-float cheb24-%data% cheb24-%offset%)
28       (cheb12 double-float cheb12-%data% cheb12-%offset%))
29    (prog ((v (make-array 12 :element-type 'double-float)) (i 0) (j 0)
30           (alam 0.0) (alam1 0.0) (alam2 0.0) (part1 0.0) (part2 0.0)
31           (part3 0.0))
32      (declare (type (array double-float (12)) v)
33               (type (double-float) part3 part2 part1 alam2 alam1 alam)
34               (type (f2cl-lib:integer4) j i))
35      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
36                    ((> i 12) nil)
37        (tagbody
38          (setf j (f2cl-lib:int-sub 26 i))
39          (setf (f2cl-lib:fref v (i) ((1 12)))
40                  (- (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
41                     (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%)))
42          (setf (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
43                  (+ (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
44                     (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%)))
45         label10))
46      (setf alam1
47              (- (f2cl-lib:fref v (1) ((1 12)))
48                 (f2cl-lib:fref v (9) ((1 12)))))
49      (setf alam2
50              (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%)
51                 (- (f2cl-lib:fref v (3) ((1 12)))
52                    (f2cl-lib:fref v (7) ((1 12)))
53                    (f2cl-lib:fref v (11) ((1 12))))))
54      (setf (f2cl-lib:fref cheb12-%data% (4) ((1 13)) cheb12-%offset%)
55              (+ alam1 alam2))
56      (setf (f2cl-lib:fref cheb12-%data% (10) ((1 13)) cheb12-%offset%)
57              (- alam1 alam2))
58      (setf alam1
59              (- (f2cl-lib:fref v (2) ((1 12)))
60                 (f2cl-lib:fref v (8) ((1 12)))
61                 (f2cl-lib:fref v (10) ((1 12)))))
62      (setf alam2
63              (- (f2cl-lib:fref v (4) ((1 12)))
64                 (f2cl-lib:fref v (6) ((1 12)))
65                 (f2cl-lib:fref v (12) ((1 12)))))
66      (setf alam
67              (+ (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) alam1)
68                 (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) alam2)))
69      (setf (f2cl-lib:fref cheb24-%data% (4) ((1 25)) cheb24-%offset%)
70              (+ (f2cl-lib:fref cheb12-%data% (4) ((1 13)) cheb12-%offset%)
71                 alam))
72      (setf (f2cl-lib:fref cheb24-%data% (22) ((1 25)) cheb24-%offset%)
73              (- (f2cl-lib:fref cheb12-%data% (4) ((1 13)) cheb12-%offset%)
74                 alam))
75      (setf alam
76              (- (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) alam1)
77                 (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) alam2)))
78      (setf (f2cl-lib:fref cheb24-%data% (10) ((1 25)) cheb24-%offset%)
79              (+ (f2cl-lib:fref cheb12-%data% (10) ((1 13)) cheb12-%offset%)
80                 alam))
81      (setf (f2cl-lib:fref cheb24-%data% (16) ((1 25)) cheb24-%offset%)
82              (- (f2cl-lib:fref cheb12-%data% (10) ((1 13)) cheb12-%offset%)
83                 alam))
84      (setf part1
85              (* (f2cl-lib:fref x-%data% (4) ((1 11)) x-%offset%)
86                 (f2cl-lib:fref v (5) ((1 12)))))
87      (setf part2
88              (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%)
89                 (f2cl-lib:fref v (9) ((1 12)))))
90      (setf part3
91              (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%)
92                 (f2cl-lib:fref v (7) ((1 12)))))
93      (setf alam1 (+ (f2cl-lib:fref v (1) ((1 12))) part1 part2))
94      (setf alam2
95              (+
96               (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%)
97                  (f2cl-lib:fref v (3) ((1 12))))
98               part3
99               (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%)
100                  (f2cl-lib:fref v (11) ((1 12))))))
101      (setf (f2cl-lib:fref cheb12-%data% (2) ((1 13)) cheb12-%offset%)
102              (+ alam1 alam2))
103      (setf (f2cl-lib:fref cheb12-%data% (12) ((1 13)) cheb12-%offset%)
104              (- alam1 alam2))
105      (setf alam
106              (+
107               (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%)
108                  (f2cl-lib:fref v (2) ((1 12))))
109               (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%)
110                  (f2cl-lib:fref v (4) ((1 12))))
111               (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%)
112                  (f2cl-lib:fref v (6) ((1 12))))
113               (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%)
114                  (f2cl-lib:fref v (8) ((1 12))))
115               (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%)
116                  (f2cl-lib:fref v (10) ((1 12))))
117               (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%)
118                  (f2cl-lib:fref v (12) ((1 12))))))
119      (setf (f2cl-lib:fref cheb24-%data% (2) ((1 25)) cheb24-%offset%)
120              (+ (f2cl-lib:fref cheb12-%data% (2) ((1 13)) cheb12-%offset%)
121                 alam))
122      (setf (f2cl-lib:fref cheb24-%data% (24) ((1 25)) cheb24-%offset%)
123              (- (f2cl-lib:fref cheb12-%data% (2) ((1 13)) cheb12-%offset%)
124                 alam))
125      (setf alam
126              (-
127               (+
128                (-
129                 (+
130                  (-
131                   (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%)
132                      (f2cl-lib:fref v (2) ((1 12))))
133                   (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%)
134                      (f2cl-lib:fref v (4) ((1 12)))))
135                  (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%)
136                     (f2cl-lib:fref v (6) ((1 12)))))
137                 (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%)
138                    (f2cl-lib:fref v (8) ((1 12)))))
139                (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%)
140                   (f2cl-lib:fref v (10) ((1 12)))))
141               (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%)
142                  (f2cl-lib:fref v (12) ((1 12))))))
143      (setf (f2cl-lib:fref cheb24-%data% (12) ((1 25)) cheb24-%offset%)
144              (+ (f2cl-lib:fref cheb12-%data% (12) ((1 13)) cheb12-%offset%)
145                 alam))
146      (setf (f2cl-lib:fref cheb24-%data% (14) ((1 25)) cheb24-%offset%)
147              (- (f2cl-lib:fref cheb12-%data% (12) ((1 13)) cheb12-%offset%)
148                 alam))
149      (setf alam1 (+ (- (f2cl-lib:fref v (1) ((1 12))) part1) part2))
150      (setf alam2
151              (+
152               (-
153                (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%)
154                   (f2cl-lib:fref v (3) ((1 12))))
155                part3)
156               (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%)
157                  (f2cl-lib:fref v (11) ((1 12))))))
158      (setf (f2cl-lib:fref cheb12-%data% (6) ((1 13)) cheb12-%offset%)
159              (+ alam1 alam2))
160      (setf (f2cl-lib:fref cheb12-%data% (8) ((1 13)) cheb12-%offset%)
161              (- alam1 alam2))
162      (setf alam
163              (+
164               (-
165                (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%)
166                   (f2cl-lib:fref v (2) ((1 12))))
167                (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%)
168                   (f2cl-lib:fref v (4) ((1 12))))
169                (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%)
170                   (f2cl-lib:fref v (6) ((1 12))))
171                (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%)
172                   (f2cl-lib:fref v (8) ((1 12)))))
173               (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%)
174                  (f2cl-lib:fref v (10) ((1 12))))
175               (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%)
176                  (f2cl-lib:fref v (12) ((1 12))))))
177      (setf (f2cl-lib:fref cheb24-%data% (6) ((1 25)) cheb24-%offset%)
178              (+ (f2cl-lib:fref cheb12-%data% (6) ((1 13)) cheb12-%offset%)
179                 alam))
180      (setf (f2cl-lib:fref cheb24-%data% (20) ((1 25)) cheb24-%offset%)
181              (- (f2cl-lib:fref cheb12-%data% (6) ((1 13)) cheb12-%offset%)
182                 alam))
183      (setf alam
184              (-
185               (+
186                (-
187                 (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%)
188                    (f2cl-lib:fref v (2) ((1 12))))
189                 (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%)
190                    (f2cl-lib:fref v (4) ((1 12))))
191                 (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%)
192                    (f2cl-lib:fref v (6) ((1 12)))))
193                (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%)
194                   (f2cl-lib:fref v (8) ((1 12)))))
195               (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%)
196                  (f2cl-lib:fref v (10) ((1 12))))
197               (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%)
198                  (f2cl-lib:fref v (12) ((1 12))))))
199      (setf (f2cl-lib:fref cheb24-%data% (8) ((1 25)) cheb24-%offset%)
200              (+ (f2cl-lib:fref cheb12-%data% (8) ((1 13)) cheb12-%offset%)
201                 alam))
202      (setf (f2cl-lib:fref cheb24-%data% (18) ((1 25)) cheb24-%offset%)
203              (- (f2cl-lib:fref cheb12-%data% (8) ((1 13)) cheb12-%offset%)
204                 alam))
205      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
206                    ((> i 6) nil)
207        (tagbody
208          (setf j (f2cl-lib:int-sub 14 i))
209          (setf (f2cl-lib:fref v (i) ((1 12)))
210                  (- (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
211                     (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%)))
212          (setf (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
213                  (+ (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
214                     (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%)))
215         label20))
216      (setf alam1
217              (+ (f2cl-lib:fref v (1) ((1 12)))
218                 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%)
219                    (f2cl-lib:fref v (5) ((1 12))))))
220      (setf alam2
221              (* (f2cl-lib:fref x-%data% (4) ((1 11)) x-%offset%)
222                 (f2cl-lib:fref v (3) ((1 12)))))
223      (setf (f2cl-lib:fref cheb12-%data% (3) ((1 13)) cheb12-%offset%)
224              (+ alam1 alam2))
225      (setf (f2cl-lib:fref cheb12-%data% (11) ((1 13)) cheb12-%offset%)
226              (- alam1 alam2))
227      (setf (f2cl-lib:fref cheb12-%data% (7) ((1 13)) cheb12-%offset%)
228              (- (f2cl-lib:fref v (1) ((1 12)))
229                 (f2cl-lib:fref v (5) ((1 12)))))
230      (setf alam
231              (+
232               (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%)
233                  (f2cl-lib:fref v (2) ((1 12))))
234               (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%)
235                  (f2cl-lib:fref v (4) ((1 12))))
236               (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%)
237                  (f2cl-lib:fref v (6) ((1 12))))))
238      (setf (f2cl-lib:fref cheb24-%data% (3) ((1 25)) cheb24-%offset%)
239              (+ (f2cl-lib:fref cheb12-%data% (3) ((1 13)) cheb12-%offset%)
240                 alam))
241      (setf (f2cl-lib:fref cheb24-%data% (23) ((1 25)) cheb24-%offset%)
242              (- (f2cl-lib:fref cheb12-%data% (3) ((1 13)) cheb12-%offset%)
243                 alam))
244      (setf alam
245              (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%)
246                 (- (f2cl-lib:fref v (2) ((1 12)))
247                    (f2cl-lib:fref v (4) ((1 12)))
248                    (f2cl-lib:fref v (6) ((1 12))))))
249      (setf (f2cl-lib:fref cheb24-%data% (7) ((1 25)) cheb24-%offset%)
250              (+ (f2cl-lib:fref cheb12-%data% (7) ((1 13)) cheb12-%offset%)
251                 alam))
252      (setf (f2cl-lib:fref cheb24-%data% (19) ((1 25)) cheb24-%offset%)
253              (- (f2cl-lib:fref cheb12-%data% (7) ((1 13)) cheb12-%offset%)
254                 alam))
255      (setf alam
256              (+
257               (-
258                (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%)
259                   (f2cl-lib:fref v (2) ((1 12))))
260                (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%)
261                   (f2cl-lib:fref v (4) ((1 12)))))
262               (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%)
263                  (f2cl-lib:fref v (6) ((1 12))))))
264      (setf (f2cl-lib:fref cheb24-%data% (11) ((1 25)) cheb24-%offset%)
265              (+ (f2cl-lib:fref cheb12-%data% (11) ((1 13)) cheb12-%offset%)
266                 alam))
267      (setf (f2cl-lib:fref cheb24-%data% (15) ((1 25)) cheb24-%offset%)
268              (- (f2cl-lib:fref cheb12-%data% (11) ((1 13)) cheb12-%offset%)
269                 alam))
270      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
271                    ((> i 3) nil)
272        (tagbody
273          (setf j (f2cl-lib:int-sub 8 i))
274          (setf (f2cl-lib:fref v (i) ((1 12)))
275                  (- (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
276                     (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%)))
277          (setf (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
278                  (+ (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%)
279                     (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%)))
280         label30))
281      (setf (f2cl-lib:fref cheb12-%data% (5) ((1 13)) cheb12-%offset%)
282              (+ (f2cl-lib:fref v (1) ((1 12)))
283                 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%)
284                    (f2cl-lib:fref v (3) ((1 12))))))
285      (setf (f2cl-lib:fref cheb12-%data% (9) ((1 13)) cheb12-%offset%)
286              (- (f2cl-lib:fref fval-%data% (1) ((1 25)) fval-%offset%)
287                 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%)
288                    (f2cl-lib:fref fval-%data% (3) ((1 25)) fval-%offset%))))
289      (setf alam
290              (* (f2cl-lib:fref x-%data% (4) ((1 11)) x-%offset%)
291                 (f2cl-lib:fref v (2) ((1 12)))))
292      (setf (f2cl-lib:fref cheb24-%data% (5) ((1 25)) cheb24-%offset%)
293              (+ (f2cl-lib:fref cheb12-%data% (5) ((1 13)) cheb12-%offset%)
294                 alam))
295      (setf (f2cl-lib:fref cheb24-%data% (21) ((1 25)) cheb24-%offset%)
296              (- (f2cl-lib:fref cheb12-%data% (5) ((1 13)) cheb12-%offset%)
297                 alam))
298      (setf alam
299              (-
300               (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%)
301                  (f2cl-lib:fref fval-%data% (2) ((1 25)) fval-%offset%))
302               (f2cl-lib:fref fval-%data% (4) ((1 25)) fval-%offset%)))
303      (setf (f2cl-lib:fref cheb24-%data% (9) ((1 25)) cheb24-%offset%)
304              (+ (f2cl-lib:fref cheb12-%data% (9) ((1 13)) cheb12-%offset%)
305                 alam))
306      (setf (f2cl-lib:fref cheb24-%data% (17) ((1 25)) cheb24-%offset%)
307              (- (f2cl-lib:fref cheb12-%data% (9) ((1 13)) cheb12-%offset%)
308                 alam))
309      (setf (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%)
310              (+ (f2cl-lib:fref fval-%data% (1) ((1 25)) fval-%offset%)
311                 (f2cl-lib:fref fval-%data% (3) ((1 25)) fval-%offset%)))
312      (setf alam
313              (+ (f2cl-lib:fref fval-%data% (2) ((1 25)) fval-%offset%)
314                 (f2cl-lib:fref fval-%data% (4) ((1 25)) fval-%offset%)))
315      (setf (f2cl-lib:fref cheb24-%data% (1) ((1 25)) cheb24-%offset%)
316              (+ (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%)
317                 alam))
318      (setf (f2cl-lib:fref cheb24-%data% (25) ((1 25)) cheb24-%offset%)
319              (- (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%)
320                 alam))
321      (setf (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%)
322              (- (f2cl-lib:fref v (1) ((1 12)))
323                 (f2cl-lib:fref v (3) ((1 12)))))
324      (setf (f2cl-lib:fref cheb24-%data% (13) ((1 25)) cheb24-%offset%)
325              (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%))
326      (setf alam (/ 1.0 6.0))
327      (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1))
328                    ((> i 12) nil)
329        (tagbody
330          (setf (f2cl-lib:fref cheb12-%data% (i) ((1 13)) cheb12-%offset%)
331                  (* (f2cl-lib:fref cheb12-%data% (i) ((1 13)) cheb12-%offset%)
332                     alam))
333         label40))
334      (setf alam (* 0.5 alam))
335      (setf (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%)
336              (* (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%)
337                 alam))
338      (setf (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%)
339              (* (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%)
340                 alam))
341      (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1))
342                    ((> i 24) nil)
343        (tagbody
344          (setf (f2cl-lib:fref cheb24-%data% (i) ((1 25)) cheb24-%offset%)
345                  (* (f2cl-lib:fref cheb24-%data% (i) ((1 25)) cheb24-%offset%)
346                     alam))
347         label50))
348      (setf (f2cl-lib:fref cheb24-%data% (1) ((1 25)) cheb24-%offset%)
349              (* 0.5
350                 alam
351                 (f2cl-lib:fref cheb24-%data% (1) ((1 25)) cheb24-%offset%)))
352      (setf (f2cl-lib:fref cheb24-%data% (25) ((1 25)) cheb24-%offset%)
353              (* 0.5
354                 alam
355                 (f2cl-lib:fref cheb24-%data% (25) ((1 25)) cheb24-%offset%)))
356      (go end_label)
357     end_label
358      (return (values nil nil nil nil)))))
359
360(in-package #-gcl #:cl-user #+gcl "CL-USER")
361#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
362(eval-when (:load-toplevel :compile-toplevel :execute)
363  (setf (gethash 'fortran-to-lisp::dqcheb
364                 fortran-to-lisp::*f2cl-function-info*)
365          (fortran-to-lisp::make-f2cl-finfo
366           :arg-types '((array double-float (*)) (array double-float (*))
367                        (array double-float (*)) (array double-float (*)))
368           :return-values '(nil nil nil nil)
369           :calls 'nil)))
370
371