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