?  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] / share / odepack / src / dprep.lisp
blob777d58c5803f1d14005512e64a8533386b62593d
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-2013-11 (20E 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 single-float))
16
17 (in-package "ODEPACK")
18
19
20 (defun dprep (neq y yh savf ewt ftem ia ja wk iwk ipper f jac)
21 (declare (type (f2cl-lib:integer4) ipper)
22 (type (array double-float (*)) wk ftem ewt savf yh y)
23 (type (array f2cl-lib:integer4 (*)) iwk ja ia neq))
24 (let ()
25 (symbol-macrolet ((tn (aref (dls001-part-0 *dls001-common-block*) 216))
26 (miter (aref (dls001-part-1 *dls001-common-block*) 26))
27 (n (aref (dls001-part-1 *dls001-common-block*) 31))
28 (seth (aref (dlss01-part-0 *dlss01-common-block*) 5))
29 (iesp (aref (dlss01-part-1 *dlss01-common-block*) 1))
30 (istatc (aref (dlss01-part-1 *dlss01-common-block*) 2))
31 (iys (aref (dlss01-part-1 *dlss01-common-block*) 3))
32 (iba (aref (dlss01-part-1 *dlss01-common-block*) 4))
33 (ibian (aref (dlss01-part-1 *dlss01-common-block*) 5))
34 (ibjan (aref (dlss01-part-1 *dlss01-common-block*) 6))
35 (ibjgp (aref (dlss01-part-1 *dlss01-common-block*) 7))
36 (ipian (aref (dlss01-part-1 *dlss01-common-block*) 8))
37 (ipjan (aref (dlss01-part-1 *dlss01-common-block*) 9))
38 (ipjgp (aref (dlss01-part-1 *dlss01-common-block*) 10))
39 (ipigp (aref (dlss01-part-1 *dlss01-common-block*) 11))
40 (ipr (aref (dlss01-part-1 *dlss01-common-block*) 12))
41 (ipc (aref (dlss01-part-1 *dlss01-common-block*) 13))
42 (ipic (aref (dlss01-part-1 *dlss01-common-block*) 14))
43 (ipisp (aref (dlss01-part-1 *dlss01-common-block*) 15))
44 (iprsp (aref (dlss01-part-1 *dlss01-common-block*) 16))
45 (ipa (aref (dlss01-part-1 *dlss01-common-block*) 17))
46 (lenwk (aref (dlss01-part-1 *dlss01-common-block*) 20))
47 (lreq (aref (dlss01-part-1 *dlss01-common-block*) 21))
48 (lrat (aref (dlss01-part-1 *dlss01-common-block*) 22))
49 (moss (aref (dlss01-part-1 *dlss01-common-block*) 25))
50 (ngp (aref (dlss01-part-1 *dlss01-common-block*) 28))
51 (nnz (aref (dlss01-part-1 *dlss01-common-block*) 30))
52 (nsp (aref (dlss01-part-1 *dlss01-common-block*) 31))
53 (nzl (aref (dlss01-part-1 *dlss01-common-block*) 32))
54 (nzu (aref (dlss01-part-1 *dlss01-common-block*) 33)))
55 (f2cl-lib:with-multi-array-data
56 ((neq f2cl-lib:integer4 neq-%data% neq-%offset%)
57 (ia f2cl-lib:integer4 ia-%data% ia-%offset%)
58 (ja f2cl-lib:integer4 ja-%data% ja-%offset%)
59 (iwk f2cl-lib:integer4 iwk-%data% iwk-%offset%)
60 (y double-float y-%data% y-%offset%)
61 (yh double-float yh-%data% yh-%offset%)
62 (savf double-float savf-%data% savf-%offset%)
63 (ewt double-float ewt-%data% ewt-%offset%)
64 (ftem double-float ftem-%data% ftem-%offset%)
65 (wk double-float wk-%data% wk-%offset%))
66 (prog ((nzsut 0) (np1 0) (maxg 0) (liwk 0) (lenigp 0) (ldif 0) (kmin 0)
67 (kmax 0) (knew 0) (k 0) (jfound 0) (j 0) (iptt2 0) (iptt1 0)
68 (ipiu 0) (ipil 0) (ier 0) (ibr 0) (i 0) (yj 0.0d0) (fac 0.0d0)
69 (erwt 0.0d0) (dyj 0.0d0) (dq 0.0d0))
70 (declare (type (double-float) dq dyj erwt fac yj)
71 (type (f2cl-lib:integer4) i ibr ier ipil ipiu iptt1 iptt2 j
72 jfound k knew kmax kmin ldif
73 lenigp liwk maxg np1 nzsut))
74 (setf ibian (f2cl-lib:int-mul lrat 2))
75 (setf ipian (f2cl-lib:int-add ibian 1))
76 (setf np1 (f2cl-lib:int-add n 1))
77 (setf ipjan (f2cl-lib:int-add ipian np1))
78 (setf ibjan (f2cl-lib:int-sub ipjan 1))
79 (setf liwk (f2cl-lib:int-mul lenwk lrat))
80 (if (> (f2cl-lib:int-sub (f2cl-lib:int-add ipjan n) 1) liwk)
81 (go label210))
82 (if (= moss 0) (go label30))
83 (if (= istatc 3) (go label20))
84 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
85 ((> i n) nil)
86 (tagbody
87 (setf erwt
88 (/ 1.0d0
89 (f2cl-lib:fref ewt-%data% (i) ((1 *)) ewt-%offset%)))
90 (setf fac (+ 1.0d0 (/ 1.0d0 (+ i 1.0d0))))
91 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
92 (+ (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
93 (* fac
94 (f2cl-lib:sign erwt
95 (f2cl-lib:fref y-%data%
96 (i)
97 ((1 *))
98 y-%offset%)))))
99 label10))
100 (f2cl-lib:computed-goto (label70 label100) moss)
101 label20
102 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
103 ((> i n) nil)
104 (tagbody
105 label25
106 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
107 (f2cl-lib:fref yh-%data% (i) ((1 *)) yh-%offset%))))
108 (f2cl-lib:computed-goto (label70 label100) moss)
109 label30
110 (setf knew ipjan)
111 (setf kmin (f2cl-lib:fref ia-%data% (1) ((1 *)) ia-%offset%))
112 (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 1)
113 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
114 ((> j n) nil)
115 (tagbody
116 (setf jfound 0)
117 (setf kmax
118 (f2cl-lib:int-sub
119 (f2cl-lib:fref ia-%data%
120 ((f2cl-lib:int-add j 1))
121 ((1 *))
122 ia-%offset%)
123 1))
124 (if (> kmin kmax) (go label45))
125 (f2cl-lib:fdo (k kmin (f2cl-lib:int-add k 1))
126 ((> k kmax) nil)
127 (tagbody
128 (setf i (f2cl-lib:fref ja-%data% (k) ((1 *)) ja-%offset%))
129 (if (= i j) (setf jfound 1))
130 (if (> knew liwk) (go label210))
131 (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%)
132 i)
133 (setf knew (f2cl-lib:int-add knew 1))
134 label40))
135 (if (= jfound 1) (go label50))
136 label45
137 (if (> knew liwk) (go label210))
138 (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%) j)
139 (setf knew (f2cl-lib:int-add knew 1))
140 label50
141 (setf (f2cl-lib:fref iwk-%data%
142 ((f2cl-lib:int-add ipian j))
143 ((1 *))
144 iwk-%offset%)
145 (f2cl-lib:int-sub (f2cl-lib:int-add knew 1) ipjan))
146 (setf kmin (f2cl-lib:int-add kmax 1))
147 label60))
148 (go label140)
149 label70
150 (multiple-value-bind (var-0 var-1 var-2 var-3)
151 (funcall f neq tn y savf)
152 (declare (ignore var-0 var-2 var-3))
153 (when var-1
154 (setf tn var-1)))
155 (setf k ipjan)
156 (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 1)
157 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
158 ((> j n) nil)
159 (tagbody
160 (if (> k liwk) (go label210))
161 (setf (f2cl-lib:fref iwk-%data% (k) ((1 *)) iwk-%offset%) j)
162 (setf k (f2cl-lib:int-add k 1))
163 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
164 ((> i n) nil)
165 (tagbody
166 label75
167 (setf (f2cl-lib:fref savf-%data% (i) ((1 *)) savf-%offset%)
168 0.0d0)))
169 (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
170 (funcall jac
171 neq
172 tn
173 y
174 j
175 (f2cl-lib:array-slice iwk-%data%
176 f2cl-lib:integer4
177 (ipian)
178 ((1 *))
179 iwk-%offset%)
180 (f2cl-lib:array-slice iwk-%data%
181 f2cl-lib:integer4
182 (ipjan)
183 ((1 *))
184 iwk-%offset%)
185 savf)
186 (declare (ignore var-0 var-2 var-4 var-5 var-6))
187 (when var-1
188 (setf tn var-1))
189 (when var-3
190 (setf j var-3)))
191 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
192 ((> i n) nil)
193 (tagbody
194 (if
195 (<=
196 (abs (f2cl-lib:fref savf-%data% (i) ((1 *)) savf-%offset%))
197 seth)
198 (go label80))
199 (if (= i j) (go label80))
200 (if (> k liwk) (go label210))
201 (setf (f2cl-lib:fref iwk-%data% (k) ((1 *)) iwk-%offset%) i)
202 (setf k (f2cl-lib:int-add k 1))
203 label80))
204 (setf (f2cl-lib:fref iwk-%data%
205 ((f2cl-lib:int-add ipian j))
206 ((1 *))
207 iwk-%offset%)
208 (f2cl-lib:int-sub (f2cl-lib:int-add k 1) ipjan))
209 label90))
210 (go label140)
211 label100
212 (setf k ipjan)
213 (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 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 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
220 ((> j n) nil)
221 (tagbody
222 (if (> k liwk) (go label210))
223 (setf (f2cl-lib:fref iwk-%data% (k) ((1 *)) iwk-%offset%) j)
224 (setf k (f2cl-lib:int-add k 1))
225 (setf yj (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%))
226 (setf erwt
227 (/ 1.0d0
228 (f2cl-lib:fref ewt-%data% (j) ((1 *)) ewt-%offset%)))
229 (setf dyj (f2cl-lib:sign erwt yj))
230 (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%) (+ yj dyj))
231 (multiple-value-bind (var-0 var-1 var-2 var-3)
232 (funcall f neq tn y ftem)
233 (declare (ignore var-0 var-2 var-3))
234 (when var-1
235 (setf tn var-1)))
236 (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%) yj)
237 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
238 ((> i n) nil)
239 (tagbody
240 (setf dq
241 (/
242 (-
243 (f2cl-lib:fref ftem-%data%
244 (i)
245 ((1 *))
246 ftem-%offset%)
247 (f2cl-lib:fref savf-%data%
248 (i)
249 ((1 *))
250 savf-%offset%))
251 dyj))
252 (if (<= (abs dq) seth) (go label110))
253 (if (= i j) (go label110))
254 (if (> k liwk) (go label210))
255 (setf (f2cl-lib:fref iwk-%data% (k) ((1 *)) iwk-%offset%) i)
256 (setf k (f2cl-lib:int-add k 1))
257 label110))
258 (setf (f2cl-lib:fref iwk-%data%
259 ((f2cl-lib:int-add ipian j))
260 ((1 *))
261 iwk-%offset%)
262 (f2cl-lib:int-sub (f2cl-lib:int-add k 1) ipjan))
263 label120))
264 label140
265 (if (or (= moss 0) (/= istatc 1)) (go label150))
266 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
267 ((> i n) nil)
268 (tagbody
269 label145
270 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
271 (f2cl-lib:fref yh-%data% (i) ((1 *)) yh-%offset%))))
272 label150
273 (setf nnz
274 (f2cl-lib:int-sub
275 (f2cl-lib:fref iwk-%data%
276 ((f2cl-lib:int-add ipian n))
277 ((1 *))
278 iwk-%offset%)
279 1))
280 (setf lenigp 0)
281 (setf ipigp (f2cl-lib:int-add ipjan nnz))
282 (if (/= miter 2) (go label160))
283 (setf maxg np1)
284 (setf ipjgp (f2cl-lib:int-add ipjan nnz))
285 (setf ibjgp (f2cl-lib:int-sub ipjgp 1))
286 (setf ipigp (f2cl-lib:int-add ipjgp n))
287 (setf iptt1 (f2cl-lib:int-add ipigp np1))
288 (setf iptt2 (f2cl-lib:int-add iptt1 n))
289 (setf lreq (f2cl-lib:int-sub (f2cl-lib:int-add iptt2 n) 1))
290 (if (> lreq liwk) (go label220))
291 (multiple-value-bind
292 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
293 (jgroup n
294 (f2cl-lib:array-slice iwk-%data%
295 f2cl-lib:integer4
296 (ipian)
297 ((1 *))
298 iwk-%offset%)
299 (f2cl-lib:array-slice iwk-%data%
300 f2cl-lib:integer4
301 (ipjan)
302 ((1 *))
303 iwk-%offset%)
304 maxg ngp
305 (f2cl-lib:array-slice iwk-%data%
306 f2cl-lib:integer4
307 (ipigp)
308 ((1 *))
309 iwk-%offset%)
310 (f2cl-lib:array-slice iwk-%data%
311 f2cl-lib:integer4
312 (ipjgp)
313 ((1 *))
314 iwk-%offset%)
315 (f2cl-lib:array-slice iwk-%data%
316 f2cl-lib:integer4
317 (iptt1)
318 ((1 *))
319 iwk-%offset%)
320 (f2cl-lib:array-slice iwk-%data%
321 f2cl-lib:integer4
322 (iptt2)
323 ((1 *))
324 iwk-%offset%)
325 ier)
326 (declare (ignore var-0 var-1 var-2 var-3 var-5 var-6 var-7 var-8))
327 (setf ngp var-4)
328 (setf ier var-9))
329 (if (/= ier 0) (go label220))
330 (setf lenigp (f2cl-lib:int-add ngp 1))
331 label160
332 (setf ipr (f2cl-lib:int-add ipigp lenigp))
333 (setf ipc ipr)
334 (setf ipic (f2cl-lib:int-add ipc n))
335 (setf ipisp (f2cl-lib:int-add ipic n))
336 (setf iprsp
337 (+ (the f2cl-lib:integer4 (truncate (- ipisp 2) lrat)) 2))
338 (setf iesp (f2cl-lib:int-sub (f2cl-lib:int-add lenwk 1) iprsp))
339 (if (< iesp 0) (go label230))
340 (setf ibr (f2cl-lib:int-sub ipr 1))
341 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
342 ((> i n) nil)
343 (tagbody
344 label170
345 (setf (f2cl-lib:fref iwk-%data%
346 ((f2cl-lib:int-add ibr i))
347 ((1 *))
348 iwk-%offset%)
349 i)))
350 (setf nsp (f2cl-lib:int-sub (f2cl-lib:int-add liwk 1) ipisp))
351 (multiple-value-bind
352 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
353 (odrv n
354 (f2cl-lib:array-slice iwk-%data%
355 f2cl-lib:integer4
356 (ipian)
357 ((1 *))
358 iwk-%offset%)
359 (f2cl-lib:array-slice iwk-%data%
360 f2cl-lib:integer4
361 (ipjan)
362 ((1 *))
363 iwk-%offset%)
364 wk
365 (f2cl-lib:array-slice iwk-%data%
366 f2cl-lib:integer4
367 (ipr)
368 ((1 *))
369 iwk-%offset%)
370 (f2cl-lib:array-slice iwk-%data%
371 f2cl-lib:integer4
372 (ipic)
373 ((1 *))
374 iwk-%offset%)
375 nsp
376 (f2cl-lib:array-slice iwk-%data%
377 f2cl-lib:integer4
378 (ipisp)
379 ((1 *))
380 iwk-%offset%)
381 1 iys)
382 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
383 var-8))
384 (setf iys var-9))
385 (if (= iys (f2cl-lib:int-add (f2cl-lib:int-mul 11 n) 1))
386 (go label240))
387 (if (/= iys 0) (go label230))
388 (setf ipa (f2cl-lib:int-sub (f2cl-lib:int-add lenwk 1) nnz))
389 (setf nsp (f2cl-lib:int-sub ipa iprsp))
390 (setf lreq
391 (+
392 (max (the f2cl-lib:integer4 (truncate (* 12 n) lrat))
393 (+ (the f2cl-lib:integer4 (truncate (* 6 n) lrat))
394 (f2cl-lib:int-mul 2 n)
395 nnz))
396 3))
397 (setf lreq
398 (f2cl-lib:int-add
399 (f2cl-lib:int-sub (f2cl-lib:int-add lreq iprsp) 1)
400 nnz))
401 (if (> lreq lenwk) (go label250))
402 (setf iba (f2cl-lib:int-sub ipa 1))
403 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
404 ((> i nnz) nil)
405 (tagbody
406 label180
407 (setf (f2cl-lib:fref wk-%data%
408 ((f2cl-lib:int-add iba i))
409 ((1 *))
410 wk-%offset%)
411 0.0d0)))
412 (setf ipisp
413 (f2cl-lib:int-add
414 (f2cl-lib:int-mul lrat (f2cl-lib:int-sub iprsp 1))
415 1))
416 (multiple-value-bind
417 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9
418 var-10 var-11 var-12 var-13 var-14)
419 (cdrv n
420 (f2cl-lib:array-slice iwk-%data%
421 f2cl-lib:integer4
422 (ipr)
423 ((1 *))
424 iwk-%offset%)
425 (f2cl-lib:array-slice iwk-%data%
426 f2cl-lib:integer4
427 (ipc)
428 ((1 *))
429 iwk-%offset%)
430 (f2cl-lib:array-slice iwk-%data%
431 f2cl-lib:integer4
432 (ipic)
433 ((1 *))
434 iwk-%offset%)
435 (f2cl-lib:array-slice iwk-%data%
436 f2cl-lib:integer4
437 (ipian)
438 ((1 *))
439 iwk-%offset%)
440 (f2cl-lib:array-slice iwk-%data%
441 f2cl-lib:integer4
442 (ipjan)
443 ((1 *))
444 iwk-%offset%)
445 (f2cl-lib:array-slice wk-%data%
446 double-float
447 (ipa)
448 ((1 *))
449 wk-%offset%)
450 (f2cl-lib:array-slice wk-%data%
451 double-float
452 (ipa)
453 ((1 *))
454 wk-%offset%)
455 (f2cl-lib:array-slice wk-%data%
456 double-float
457 (ipa)
458 ((1 *))
459 wk-%offset%)
460 nsp
461 (f2cl-lib:array-slice iwk-%data%
462 f2cl-lib:integer4
463 (ipisp)
464 ((1 *))
465 iwk-%offset%)
466 (f2cl-lib:array-slice wk-%data%
467 double-float
468 (iprsp)
469 ((1 *))
470 wk-%offset%)
471 iesp 5 iys)
472 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
473 var-8 var-9 var-10 var-11 var-13))
474 (setf iesp var-12)
475 (setf iys var-14))
476 (setf lreq (f2cl-lib:int-sub lenwk iesp))
477 (if (= iys (f2cl-lib:int-add (f2cl-lib:int-mul 10 n) 1))
478 (go label250))
479 (if (/= iys 0) (go label260))
480 (setf ipil ipisp)
481 (setf ipiu (f2cl-lib:int-add ipil (f2cl-lib:int-mul 2 n) 1))
482 (setf nzu
483 (f2cl-lib:int-sub
484 (f2cl-lib:fref iwk-%data%
485 ((f2cl-lib:int-add ipil n))
486 ((1 *))
487 iwk-%offset%)
488 (f2cl-lib:fref iwk-%data% (ipil) ((1 *)) iwk-%offset%)))
489 (setf nzl
490 (f2cl-lib:int-sub
491 (f2cl-lib:fref iwk-%data%
492 ((f2cl-lib:int-add ipiu n))
493 ((1 *))
494 iwk-%offset%)
495 (f2cl-lib:fref iwk-%data% (ipiu) ((1 *)) iwk-%offset%)))
496 (if (> lrat 1) (go label190))
497 (multiple-value-bind (var-0 var-1 var-2)
498 (adjlr n
499 (f2cl-lib:array-slice iwk-%data%
500 f2cl-lib:integer4
501 (ipisp)
502 ((1 *))
503 iwk-%offset%)
504 ldif)
505 (declare (ignore var-0 var-1))
506 (setf ldif var-2))
507 (setf lreq (f2cl-lib:int-add lreq ldif))
508 label190
509 (if (and (= lrat 2) (= nnz n)) (setf lreq (f2cl-lib:int-add lreq 1)))
510 (setf nsp (f2cl-lib:int-sub (f2cl-lib:int-add nsp lreq) lenwk))
511 (setf ipa (f2cl-lib:int-sub (f2cl-lib:int-add lreq 1) nnz))
512 (setf iba (f2cl-lib:int-sub ipa 1))
513 (setf ipper 0)
514 (go end_label)
515 label210
516 (setf ipper -1)
517 (setf lreq
518 (+ 2 (the f2cl-lib:integer4 (truncate (+ (* 2 n) 1) lrat))))
519 (setf lreq
520 (max (the f2cl-lib:integer4 (f2cl-lib:int-add lenwk 1))
521 (the f2cl-lib:integer4 lreq)))
522 (go end_label)
523 label220
524 (setf ipper -2)
525 (setf lreq (+ (the f2cl-lib:integer4 (truncate (- lreq 1) lrat)) 1))
526 (go end_label)
527 label230
528 (setf ipper -3)
529 (multiple-value-bind (var-0 var-1 var-2 var-3)
530 (cntnzu n
531 (f2cl-lib:array-slice iwk-%data%
532 f2cl-lib:integer4
533 (ipian)
534 ((1 *))
535 iwk-%offset%)
536 (f2cl-lib:array-slice iwk-%data%
537 f2cl-lib:integer4
538 (ipjan)
539 ((1 *))
540 iwk-%offset%)
541 nzsut)
542 (declare (ignore var-0 var-1 var-2))
543 (setf nzsut var-3))
544 (setf lreq
545 (+ (f2cl-lib:int-sub lenwk iesp)
546 (the f2cl-lib:integer4
547 (truncate (- (+ (* 3 n) (* 4 nzsut)) 1) lrat))
548 1))
549 (go end_label)
550 label240
551 (setf ipper -4)
552 (go end_label)
553 label250
554 (setf ipper -5)
555 (go end_label)
556 label260
557 (setf ipper -6)
558 (setf lreq lenwk)
559 (go end_label)
560 end_label
561 (return
562 (values nil nil nil nil nil nil nil nil nil nil ipper nil nil)))))))
563
564 (in-package #:cl-user)
565 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
566 (eval-when (:load-toplevel :compile-toplevel :execute)
567 (setf (gethash 'fortran-to-lisp::dprep fortran-to-lisp::*f2cl-function-info*)
568 (fortran-to-lisp::make-f2cl-finfo
569 :arg-types '((array fortran-to-lisp::integer4 (*))
570 (array double-float (*)) (array double-float (*))
571 (array double-float (*)) (array double-float (*))
572 (array double-float (*))
573 (array fortran-to-lisp::integer4 (*))
574 (array fortran-to-lisp::integer4 (*))
575 (array double-float (*))
576 (array fortran-to-lisp::integer4 (*))
577 (fortran-to-lisp::integer4) t t)
578 :return-values '(nil nil nil nil nil nil nil nil nil nil
579 fortran-to-lisp::ipper nil nil)
580 :calls '(fortran-to-lisp::cntnzu fortran-to-lisp::adjlr
581 fortran-to-lisp::cdrv fortran-to-lisp::odrv
582 fortran-to-lisp::jgroup))))
583
Maxima, a Computer Algebra System