1;;; Compiled by f2cl version:
2;;; ("f2cl1.l,v 95098eb54f13 2013/04/01 00:45:16 toy $"
3;;;  "f2cl2.l,v 95098eb54f13 2013/04/01 00:45:16 toy $"
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 95098eb54f13 2013/04/01 00:45:16 toy $"
7;;;  "f2cl6.l,v 1d5cbacbb977 2008/08/24 00:56:27 rtoy $"
8;;;  "macros.l,v 1409c1352feb 2013/03/24 20:44:50 toy $")
9
10;;; Using Lisp CMU Common Lisp snapshot-2017-01 (21B 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 t) (:declare-common nil)
15;;;           (:float-format double-float))
16
17(in-package "ODEPACK")
18
19
20(defun dstode (neq y yh nyh yh1 ewt savf acor wm iwm f jac pjac slvs)
21  (declare (type (f2cl-lib:integer4) nyh)
22           (type (array double-float (*)) wm acor savf ewt yh1 yh y)
23           (type (array f2cl-lib:integer4 (*)) iwm neq))
24  (let ((dls001-el
25         (make-array 13
26                     :element-type 'double-float
27                     :displaced-to (dls001-part-0 *dls001-common-block*)
28                     :displaced-index-offset 2))
29        (dls001-elco
30         (make-array 156
31                     :element-type 'double-float
32                     :displaced-to (dls001-part-0 *dls001-common-block*)
33                     :displaced-index-offset 15))
34        (dls001-tesco
35         (make-array 36
36                     :element-type 'double-float
37                     :displaced-to (dls001-part-0 *dls001-common-block*)
38                     :displaced-index-offset 173)))
39    (symbol-macrolet ((conit (aref (dls001-part-0 *dls001-common-block*) 0))
40                      (crate (aref (dls001-part-0 *dls001-common-block*) 1))
41                      (el dls001-el)
42                      (elco dls001-elco)
43                      (hold (aref (dls001-part-0 *dls001-common-block*) 171))
44                      (rmax (aref (dls001-part-0 *dls001-common-block*) 172))
45                      (tesco dls001-tesco)
46                      (ccmax (aref (dls001-part-0 *dls001-common-block*) 209))
47                      (el0 (aref (dls001-part-0 *dls001-common-block*) 210))
48                      (h (aref (dls001-part-0 *dls001-common-block*) 211))
49                      (hmin (aref (dls001-part-0 *dls001-common-block*) 212))
50                      (hmxi (aref (dls001-part-0 *dls001-common-block*) 213))
51                      (hu (aref (dls001-part-0 *dls001-common-block*) 214))
52                      (rc (aref (dls001-part-0 *dls001-common-block*) 215))
53                      (tn (aref (dls001-part-0 *dls001-common-block*) 216))
54                      (ialth (aref (dls001-part-1 *dls001-common-block*) 6))
55                      (ipup (aref (dls001-part-1 *dls001-common-block*) 7))
56                      (lmax (aref (dls001-part-1 *dls001-common-block*) 8))
57                      (meo (aref (dls001-part-1 *dls001-common-block*) 9))
58                      (nqnyh (aref (dls001-part-1 *dls001-common-block*) 10))
59                      (nslp (aref (dls001-part-1 *dls001-common-block*) 11))
60                      (icf (aref (dls001-part-1 *dls001-common-block*) 12))
61                      (ierpj (aref (dls001-part-1 *dls001-common-block*) 13))
62                      (iersl (aref (dls001-part-1 *dls001-common-block*) 14))
63                      (jcur (aref (dls001-part-1 *dls001-common-block*) 15))
64                      (jstart (aref (dls001-part-1 *dls001-common-block*) 16))
65                      (kflag (aref (dls001-part-1 *dls001-common-block*) 17))
66                      (l (aref (dls001-part-1 *dls001-common-block*) 18))
67                      (meth (aref (dls001-part-1 *dls001-common-block*) 25))
68                      (miter (aref (dls001-part-1 *dls001-common-block*) 26))
69                      (maxord (aref (dls001-part-1 *dls001-common-block*) 27))
70                      (maxcor (aref (dls001-part-1 *dls001-common-block*) 28))
71                      (msbp (aref (dls001-part-1 *dls001-common-block*) 29))
72                      (mxncf (aref (dls001-part-1 *dls001-common-block*) 30))
73                      (n (aref (dls001-part-1 *dls001-common-block*) 31))
74                      (nq (aref (dls001-part-1 *dls001-common-block*) 32))
75                      (nst (aref (dls001-part-1 *dls001-common-block*) 33))
76                      (nfe (aref (dls001-part-1 *dls001-common-block*) 34))
77                      (nqu (aref (dls001-part-1 *dls001-common-block*) 36)))
78      (prog ((newq 0) (ncf 0) (m 0) (jb 0) (j 0) (iret 0) (iredo 0) (i1 0)
79             (i 0) (told 0.0) (rhup 0.0) (rhsm 0.0) (rhdn 0.0) (rh 0.0) (r 0.0)
80             (exup 0.0) (exsm 0.0) (exdn 0.0) (dup 0.0) (dsm 0.0) (delp 0.0)
81             (del 0.0) (ddn 0.0) (dcon 0.0))
82        (declare (type (double-float) dcon ddn del delp dsm dup exdn exsm exup
83                                      r rh rhdn rhsm rhup told)
84                 (type (f2cl-lib:integer4) i i1 iredo iret j jb m ncf newq))
85        (setf kflag 0)
86        (setf told tn)
87        (setf ncf 0)
88        (setf ierpj 0)
89        (setf iersl 0)
90        (setf jcur 0)
91        (setf icf 0)
92        (setf delp 0.0)
93        (if (> jstart 0) (go label200))
94        (if (= jstart -1) (go label100))
95        (if (= jstart -2) (go label160))
96        (setf lmax (f2cl-lib:int-add maxord 1))
97        (setf nq 1)
98        (setf l 2)
99        (setf ialth 2)
100        (setf rmax 10000.0)
101        (setf rc 0.0)
102        (setf el0 1.0)
103        (setf crate 0.7)
104        (setf hold h)
105        (setf meo meth)
106        (setf nslp 0)
107        (setf ipup miter)
108        (setf iret 3)
109        (go label140)
110       label100
111        (setf ipup miter)
112        (setf lmax (f2cl-lib:int-add maxord 1))
113        (if (= ialth 1) (setf ialth 2))
114        (if (= meth meo) (go label110))
115        (dcfode meth elco tesco)
116        (setf meo meth)
117        (if (> nq maxord) (go label120))
118        (setf ialth l)
119        (setf iret 1)
120        (go label150)
121       label110
122        (if (<= nq maxord) (go label160))
123       label120
124        (setf nq maxord)
125        (setf l lmax)
126        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
127                      ((> i l) nil)
128          (tagbody
129           label125
130            (setf (f2cl-lib:fref el (i) ((1 13)))
131                    (f2cl-lib:fref elco (i nq) ((1 13) (1 12))))))
132        (setf nqnyh (f2cl-lib:int-mul nq nyh))
133        (setf rc (/ (* rc (f2cl-lib:fref el (1) ((1 13)))) el0))
134        (setf el0 (f2cl-lib:fref el (1) ((1 13))))
135        (setf conit (/ 0.5 (f2cl-lib:int-add nq 2)))
136        (setf ddn
137                (/ (dvnorm n savf ewt)
138                   (f2cl-lib:fref tesco (1 l) ((1 3) (1 12)))))
139        (setf exdn (/ 1.0 l))
140        (setf rhdn (/ 1.0 (+ (* 1.3 (expt ddn exdn)) 1.3e-6)))
141        (setf rh (min rhdn 1.0))
142        (setf iredo 3)
143        (if (= h hold) (go label170))
144        (setf rh (min rh (abs (/ h hold))))
145        (setf h hold)
146        (go label175)
147       label140
148        (dcfode meth elco tesco)
149       label150
150        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
151                      ((> i l) nil)
152          (tagbody
153           label155
154            (setf (f2cl-lib:fref el (i) ((1 13)))
155                    (f2cl-lib:fref elco (i nq) ((1 13) (1 12))))))
156        (setf nqnyh (f2cl-lib:int-mul nq nyh))
157        (setf rc (/ (* rc (f2cl-lib:fref el (1) ((1 13)))) el0))
158        (setf el0 (f2cl-lib:fref el (1) ((1 13))))
159        (setf conit (/ 0.5 (f2cl-lib:int-add nq 2)))
160        (f2cl-lib:computed-goto (label160 label170 label200) iret)
161       label160
162        (if (= h hold) (go label200))
163        (setf rh (/ h hold))
164        (setf h hold)
165        (setf iredo 3)
166        (go label175)
167       label170
168        (setf rh (max rh (/ hmin (abs h))))
169       label175
170        (setf rh (min rh rmax))
171        (setf rh (/ rh (max 1.0 (* (abs h) hmxi rh))))
172        (setf r 1.0)
173        (f2cl-lib:fdo (j 2 (f2cl-lib:int-add j 1))
174                      ((> j l) nil)
175          (tagbody
176            (setf r (* r rh))
177            (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
178                          ((> i n) nil)
179              (tagbody
180                (setf (f2cl-lib:fref yh (i j) ((1 nyh) (1 *)))
181                        (* (f2cl-lib:fref yh (i j) ((1 nyh) (1 *))) r))))))
182       label180
183        (setf h (* h rh))
184        (setf rc (* rc rh))
185        (setf ialth l)
186        (if (= iredo 0) (go label690))
187       label200
188        (if (> (abs (- rc 1.0)) ccmax) (setf ipup miter))
189        (if (>= nst (f2cl-lib:int-add nslp msbp)) (setf ipup miter))
190        (setf tn (+ tn h))
191        (setf i1 (f2cl-lib:int-add nqnyh 1))
192        (f2cl-lib:fdo (jb 1 (f2cl-lib:int-add jb 1))
193                      ((> jb nq) nil)
194          (tagbody
195            (setf i1 (f2cl-lib:int-sub i1 nyh))
196            (f2cl-lib:fdo (i i1 (f2cl-lib:int-add i 1))
197                          ((> i nqnyh) nil)
198              (tagbody
199               label210
200                (setf (f2cl-lib:fref yh1 (i) ((1 *)))
201                        (+ (f2cl-lib:fref yh1 (i) ((1 *)))
202                           (f2cl-lib:fref yh1
203                                          ((f2cl-lib:int-add i nyh))
204                                          ((1 *)))))))
205           label215))
206       label220
207        (setf m 0)
208        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
209                      ((> i n) nil)
210          (tagbody
211           label230
212            (setf (f2cl-lib:fref y (i) ((1 *)))
213                    (f2cl-lib:fref yh (i 1) ((1 nyh) (1 *))))))
214        (multiple-value-bind (var-0 var-1 var-2 var-3)
215            (funcall f neq tn y savf)
216          (declare (ignore var-0 var-2 var-3))
217          (when var-1
218            (setf tn var-1)))
219        (setf nfe (f2cl-lib:int-add nfe 1))
220        (if (<= ipup 0) (go label250))
221        (multiple-value-bind
222              (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9
223               var-10)
224            (funcall pjac neq y yh nyh ewt acor savf wm iwm f jac)
225          (declare (ignore var-0 var-1 var-2 var-4 var-5 var-6 var-7 var-8
226                           var-9 var-10))
227          (when var-3
228            (setf nyh var-3)))
229        (setf ipup 0)
230        (setf rc 1.0)
231        (setf nslp nst)
232        (setf crate 0.7)
233        (if (/= ierpj 0) (go label430))
234       label250
235        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
236                      ((> i n) nil)
237          (tagbody label260 (setf (f2cl-lib:fref acor (i) ((1 *))) 0.0)))
238       label270
239        (if (/= miter 0) (go label350))
240        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
241                      ((> i n) nil)
242          (tagbody
243            (setf (f2cl-lib:fref savf (i) ((1 *)))
244                    (- (* h (f2cl-lib:fref savf (i) ((1 *))))
245                       (f2cl-lib:fref yh (i 2) ((1 nyh) (1 *)))))
246           label290
247            (setf (f2cl-lib:fref y (i) ((1 *)))
248                    (- (f2cl-lib:fref savf (i) ((1 *)))
249                       (f2cl-lib:fref acor (i) ((1 *)))))))
250        (setf del (dvnorm n y ewt))
251        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
252                      ((> i n) nil)
253          (tagbody
254            (setf (f2cl-lib:fref y (i) ((1 *)))
255                    (+ (f2cl-lib:fref yh (i 1) ((1 nyh) (1 *)))
256                       (* (f2cl-lib:fref el (1) ((1 13)))
257                          (f2cl-lib:fref savf (i) ((1 *))))))
258           label300
259            (setf (f2cl-lib:fref acor (i) ((1 *)))
260                    (f2cl-lib:fref savf (i) ((1 *))))))
261        (go label400)
262       label350
263        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
264                      ((> i n) nil)
265          (tagbody
266           label360
267            (setf (f2cl-lib:fref y (i) ((1 *)))
268                    (- (* h (f2cl-lib:fref savf (i) ((1 *))))
269                       (+ (f2cl-lib:fref yh (i 2) ((1 nyh) (1 *)))
270                          (f2cl-lib:fref acor (i) ((1 *))))))))
271        (funcall slvs wm iwm y savf)
272        (if (< iersl 0) (go label430))
273        (if (> iersl 0) (go label410))
274        (setf del (dvnorm n y ewt))
275        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
276                      ((> i n) nil)
277          (tagbody
278            (setf (f2cl-lib:fref acor (i) ((1 *)))
279                    (+ (f2cl-lib:fref acor (i) ((1 *)))
280                       (f2cl-lib:fref y (i) ((1 *)))))
281           label380
282            (setf (f2cl-lib:fref y (i) ((1 *)))
283                    (+ (f2cl-lib:fref yh (i 1) ((1 nyh) (1 *)))
284                       (* (f2cl-lib:fref el (1) ((1 13)))
285                          (f2cl-lib:fref acor (i) ((1 *))))))))
286       label400
287        (if (/= m 0) (setf crate (max (* 0.2 crate) (/ del delp))))
288        (setf dcon
289                (/ (* del (min 1.0 (* 1.5 crate)))
290                   (* (f2cl-lib:fref tesco (2 nq) ((1 3) (1 12))) conit)))
291        (if (<= dcon 1.0) (go label450))
292        (setf m (f2cl-lib:int-add m 1))
293        (if (= m maxcor) (go label410))
294        (if (and (>= m 2) (> del (* 2.0 delp))) (go label410))
295        (setf delp del)
296        (multiple-value-bind (var-0 var-1 var-2 var-3)
297            (funcall f neq tn y savf)
298          (declare (ignore var-0 var-2 var-3))
299          (when var-1
300            (setf tn var-1)))
301        (setf nfe (f2cl-lib:int-add nfe 1))
302        (go label270)
303       label410
304        (if (or (= miter 0) (= jcur 1)) (go label430))
305        (setf icf 1)
306        (setf ipup miter)
307        (go label220)
308       label430
309        (setf icf 2)
310        (setf ncf (f2cl-lib:int-add ncf 1))
311        (setf rmax 2.0)
312        (setf tn told)
313        (setf i1 (f2cl-lib:int-add nqnyh 1))
314        (f2cl-lib:fdo (jb 1 (f2cl-lib:int-add jb 1))
315                      ((> jb nq) nil)
316          (tagbody
317            (setf i1 (f2cl-lib:int-sub i1 nyh))
318            (f2cl-lib:fdo (i i1 (f2cl-lib:int-add i 1))
319                          ((> i nqnyh) nil)
320              (tagbody
321               label440
322                (setf (f2cl-lib:fref yh1 (i) ((1 *)))
323                        (- (f2cl-lib:fref yh1 (i) ((1 *)))
324                           (f2cl-lib:fref yh1
325                                          ((f2cl-lib:int-add i nyh))
326                                          ((1 *)))))))
327           label445))
328        (if (or (< ierpj 0) (< iersl 0)) (go label680))
329        (if (<= (abs h) (* hmin 1.00001)) (go label670))
330        (if (= ncf mxncf) (go label670))
331        (setf rh 0.25)
332        (setf ipup miter)
333        (setf iredo 1)
334        (go label170)
335       label450
336        (setf jcur 0)
337        (if (= m 0)
338            (setf dsm (/ del (f2cl-lib:fref tesco (2 nq) ((1 3) (1 12))))))
339        (if (> m 0)
340            (setf dsm
341                    (/ (dvnorm n acor ewt)
342                       (f2cl-lib:fref tesco (2 nq) ((1 3) (1 12))))))
343        (if (> dsm 1.0) (go label500))
344        (setf kflag 0)
345        (setf iredo 0)
346        (setf nst (f2cl-lib:int-add nst 1))
347        (setf hu h)
348        (setf nqu nq)
349        (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
350                      ((> j l) nil)
351          (tagbody
352            (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
353                          ((> i n) nil)
354              (tagbody
355                (setf (f2cl-lib:fref yh (i j) ((1 nyh) (1 *)))
356                        (+ (f2cl-lib:fref yh (i j) ((1 nyh) (1 *)))
357                           (* (f2cl-lib:fref el (j) ((1 13)))
358                              (f2cl-lib:fref acor (i) ((1 *))))))))))
359       label470
360        (setf ialth (f2cl-lib:int-sub ialth 1))
361        (if (= ialth 0) (go label520))
362        (if (> ialth 1) (go label700))
363        (if (= l lmax) (go label700))
364        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
365                      ((> i n) nil)
366          (tagbody
367           label490
368            (setf (f2cl-lib:fref yh (i lmax) ((1 nyh) (1 *)))
369                    (f2cl-lib:fref acor (i) ((1 *))))))
370        (go label700)
371       label500
372        (setf kflag (f2cl-lib:int-sub kflag 1))
373        (setf tn told)
374        (setf i1 (f2cl-lib:int-add nqnyh 1))
375        (f2cl-lib:fdo (jb 1 (f2cl-lib:int-add jb 1))
376                      ((> jb nq) nil)
377          (tagbody
378            (setf i1 (f2cl-lib:int-sub i1 nyh))
379            (f2cl-lib:fdo (i i1 (f2cl-lib:int-add i 1))
380                          ((> i nqnyh) nil)
381              (tagbody
382               label510
383                (setf (f2cl-lib:fref yh1 (i) ((1 *)))
384                        (- (f2cl-lib:fref yh1 (i) ((1 *)))
385                           (f2cl-lib:fref yh1
386                                          ((f2cl-lib:int-add i nyh))
387                                          ((1 *)))))))
388           label515))
389        (setf rmax 2.0)
390        (if (<= (abs h) (* hmin 1.00001)) (go label660))
391        (if (<= kflag -3) (go label640))
392        (setf iredo 2)
393        (setf rhup 0.0)
394        (go label540)
395       label520
396        (setf rhup 0.0)
397        (if (= l lmax) (go label540))
398        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
399                      ((> i n) nil)
400          (tagbody
401           label530
402            (setf (f2cl-lib:fref savf (i) ((1 *)))
403                    (- (f2cl-lib:fref acor (i) ((1 *)))
404                       (f2cl-lib:fref yh (i lmax) ((1 nyh) (1 *)))))))
405        (setf dup
406                (/ (dvnorm n savf ewt)
407                   (f2cl-lib:fref tesco (3 nq) ((1 3) (1 12)))))
408        (setf exup (/ 1.0 (f2cl-lib:int-add l 1)))
409        (setf rhup (/ 1.0 (+ (* 1.4 (expt dup exup)) 1.4e-6)))
410       label540
411        (setf exsm (/ 1.0 l))
412        (setf rhsm (/ 1.0 (+ (* 1.2 (expt dsm exsm)) 1.2e-6)))
413        (setf rhdn 0.0)
414        (if (= nq 1) (go label560))
415        (setf ddn
416                (/
417                 (dvnorm n
418                  (f2cl-lib:array-slice yh double-float (1 l) ((1 nyh) (1 *)))
419                  ewt)
420                 (f2cl-lib:fref tesco (1 nq) ((1 3) (1 12)))))
421        (setf exdn (/ 1.0 nq))
422        (setf rhdn (/ 1.0 (+ (* 1.3 (expt ddn exdn)) 1.3e-6)))
423       label560
424        (if (>= rhsm rhup) (go label570))
425        (if (> rhup rhdn) (go label590))
426        (go label580)
427       label570
428        (if (< rhsm rhdn) (go label580))
429        (setf newq nq)
430        (setf rh rhsm)
431        (go label620)
432       label580
433        (setf newq (f2cl-lib:int-sub nq 1))
434        (setf rh rhdn)
435        (if (and (< kflag 0) (> rh 1.0)) (setf rh 1.0))
436        (go label620)
437       label590
438        (setf newq l)
439        (setf rh rhup)
440        (if (< rh 1.1) (go label610))
441        (setf r (/ (f2cl-lib:fref el (l) ((1 13))) l))
442        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
443                      ((> i n) nil)
444          (tagbody
445           label600
446            (setf (f2cl-lib:fref yh
447                                 (i (f2cl-lib:int-add newq 1))
448                                 ((1 nyh) (1 *)))
449                    (* (f2cl-lib:fref acor (i) ((1 *))) r))))
450        (go label630)
451       label610
452        (setf ialth 3)
453        (go label700)
454       label620
455        (if (and (= kflag 0) (< rh 1.1)) (go label610))
456        (if (<= kflag -2) (setf rh (min rh 0.2)))
457        (if (= newq nq) (go label170))
458       label630
459        (setf nq newq)
460        (setf l (f2cl-lib:int-add nq 1))
461        (setf iret 2)
462        (go label150)
463       label640
464        (if (= kflag -10) (go label660))
465        (setf rh 0.1)
466        (setf rh (max (/ hmin (abs h)) rh))
467        (setf h (* h rh))
468        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
469                      ((> i n) nil)
470          (tagbody
471           label645
472            (setf (f2cl-lib:fref y (i) ((1 *)))
473                    (f2cl-lib:fref yh (i 1) ((1 nyh) (1 *))))))
474        (multiple-value-bind (var-0 var-1 var-2 var-3)
475            (funcall f neq tn y savf)
476          (declare (ignore var-0 var-2 var-3))
477          (when var-1
478            (setf tn var-1)))
479        (setf nfe (f2cl-lib:int-add nfe 1))
480        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
481                      ((> i n) nil)
482          (tagbody
483           label650
484            (setf (f2cl-lib:fref yh (i 2) ((1 nyh) (1 *)))
485                    (* h (f2cl-lib:fref savf (i) ((1 *)))))))
486        (setf ipup miter)
487        (setf ialth 5)
488        (if (= nq 1) (go label200))
489        (setf nq 1)
490        (setf l 2)
491        (setf iret 3)
492        (go label150)
493       label660
494        (setf kflag -1)
495        (go label720)
496       label670
497        (setf kflag -2)
498        (go label720)
499       label680
500        (setf kflag -3)
501        (go label720)
502       label690
503        (setf rmax 10.0)
504       label700
505        (setf r (/ 1.0 (f2cl-lib:fref tesco (2 nqu) ((1 3) (1 12)))))
506        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
507                      ((> i n) nil)
508          (tagbody
509           label710
510            (setf (f2cl-lib:fref acor (i) ((1 *)))
511                    (* (f2cl-lib:fref acor (i) ((1 *))) r))))
512       label720
513        (setf hold h)
514        (setf jstart 1)
515        (go end_label)
516       end_label
517        (return
518         (values nil nil nil nyh nil nil nil nil nil nil nil nil nil nil))))))
519
520(in-package #-gcl #:cl-user #+gcl "CL-USER")
521#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
522(eval-when (:load-toplevel :compile-toplevel :execute)
523  (setf (gethash 'fortran-to-lisp::dstode
524                 fortran-to-lisp::*f2cl-function-info*)
525          (fortran-to-lisp::make-f2cl-finfo
526           :arg-types '((array fortran-to-lisp::integer4 (*))
527                        (array double-float (*)) (array double-float (*))
528                        (fortran-to-lisp::integer4) (array double-float (*))
529                        (array double-float (*)) (array double-float (*))
530                        (array double-float (*)) (array double-float (*))
531                        (array fortran-to-lisp::integer4 (*)) t t t t)
532           :return-values '(nil nil nil fortran-to-lisp::nyh nil nil nil nil
533                            nil nil nil nil nil nil)
534           :calls '(fortran-to-lisp::dvnorm fortran-to-lisp::dcfode))))
535
536