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(let ((mord 21 (make-array 2 22 :element-type 'f2cl-lib:integer4 23 :initial-contents '(12 5))) 24 (mxstp0 500) 25 (mxhnl0 10) 26 (lenrat 2)) 27 (declare (type (array f2cl-lib:integer4 (2)) mord) 28 (type (f2cl-lib:integer4) mxstp0 mxhnl0 lenrat)) 29 (defun dlsodes 30 (f neq y t$ tout itol rtol atol itask istate iopt rwork lrw iwork liw 31 jac mf) 32 (declare (type (f2cl-lib:integer4) mf liw lrw iopt istate itask itol) 33 (type (double-float) tout t$) 34 (type (array double-float (*)) rwork atol rtol y) 35 (type (array f2cl-lib:integer4 (*)) iwork neq)) 36 (let () 37 (symbol-macrolet ((ccmax 38 (aref (dls001-part-0 *dls001-common-block*) 209)) 39 (h (aref (dls001-part-0 *dls001-common-block*) 211)) 40 (hmin (aref (dls001-part-0 *dls001-common-block*) 212)) 41 (hmxi (aref (dls001-part-0 *dls001-common-block*) 213)) 42 (hu (aref (dls001-part-0 *dls001-common-block*) 214)) 43 (tn (aref (dls001-part-0 *dls001-common-block*) 216)) 44 (uround 45 (aref (dls001-part-0 *dls001-common-block*) 217)) 46 (init (aref (dls001-part-1 *dls001-common-block*) 0)) 47 (mxstep (aref (dls001-part-1 *dls001-common-block*) 1)) 48 (mxhnil (aref (dls001-part-1 *dls001-common-block*) 2)) 49 (nhnil (aref (dls001-part-1 *dls001-common-block*) 3)) 50 (nslast (aref (dls001-part-1 *dls001-common-block*) 4)) 51 (nyh (aref (dls001-part-1 *dls001-common-block*) 5)) 52 (jstart 53 (aref (dls001-part-1 *dls001-common-block*) 16)) 54 (kflag (aref (dls001-part-1 *dls001-common-block*) 17)) 55 (l (aref (dls001-part-1 *dls001-common-block*) 18)) 56 (lyh (aref (dls001-part-1 *dls001-common-block*) 19)) 57 (lewt (aref (dls001-part-1 *dls001-common-block*) 20)) 58 (lacor (aref (dls001-part-1 *dls001-common-block*) 21)) 59 (lsavf (aref (dls001-part-1 *dls001-common-block*) 22)) 60 (lwm (aref (dls001-part-1 *dls001-common-block*) 23)) 61 (meth (aref (dls001-part-1 *dls001-common-block*) 25)) 62 (miter (aref (dls001-part-1 *dls001-common-block*) 26)) 63 (maxord 64 (aref (dls001-part-1 *dls001-common-block*) 27)) 65 (maxcor 66 (aref (dls001-part-1 *dls001-common-block*) 28)) 67 (msbp (aref (dls001-part-1 *dls001-common-block*) 29)) 68 (mxncf (aref (dls001-part-1 *dls001-common-block*) 30)) 69 (n (aref (dls001-part-1 *dls001-common-block*) 31)) 70 (nq (aref (dls001-part-1 *dls001-common-block*) 32)) 71 (nst (aref (dls001-part-1 *dls001-common-block*) 33)) 72 (nfe (aref (dls001-part-1 *dls001-common-block*) 34)) 73 (nje (aref (dls001-part-1 *dls001-common-block*) 35)) 74 (nqu (aref (dls001-part-1 *dls001-common-block*) 36)) 75 (ccmxj (aref (dlss01-part-0 *dlss01-common-block*) 2)) 76 (psmall (aref (dlss01-part-0 *dlss01-common-block*) 3)) 77 (rbig (aref (dlss01-part-0 *dlss01-common-block*) 4)) 78 (seth (aref (dlss01-part-0 *dlss01-common-block*) 5)) 79 (istatc (aref (dlss01-part-1 *dlss01-common-block*) 2)) 80 (iys (aref (dlss01-part-1 *dlss01-common-block*) 3)) 81 (ipian (aref (dlss01-part-1 *dlss01-common-block*) 8)) 82 (ipjan (aref (dlss01-part-1 *dlss01-common-block*) 9)) 83 (lenyh (aref (dlss01-part-1 *dlss01-common-block*) 18)) 84 (lenyhm 85 (aref (dlss01-part-1 *dlss01-common-block*) 19)) 86 (lenwk (aref (dlss01-part-1 *dlss01-common-block*) 20)) 87 (lrat (aref (dlss01-part-1 *dlss01-common-block*) 22)) 88 (lrest (aref (dlss01-part-1 *dlss01-common-block*) 23)) 89 (lwmin (aref (dlss01-part-1 *dlss01-common-block*) 24)) 90 (moss (aref (dlss01-part-1 *dlss01-common-block*) 25)) 91 (msbj (aref (dlss01-part-1 *dlss01-common-block*) 26)) 92 (nslj (aref (dlss01-part-1 *dlss01-common-block*) 27)) 93 (ngp (aref (dlss01-part-1 *dlss01-common-block*) 28)) 94 (nlu (aref (dlss01-part-1 *dlss01-common-block*) 29)) 95 (nnz (aref (dlss01-part-1 *dlss01-common-block*) 30)) 96 (nzl (aref (dlss01-part-1 *dlss01-common-block*) 32)) 97 (nzu (aref (dlss01-part-1 *dlss01-common-block*) 33))) 98 (f2cl-lib:with-multi-array-data 99 ((neq f2cl-lib:integer4 neq-%data% neq-%offset%) 100 (iwork f2cl-lib:integer4 iwork-%data% iwork-%offset%) 101 (y double-float y-%data% y-%offset%) 102 (rtol double-float rtol-%data% rtol-%offset%) 103 (atol double-float atol-%data% atol-%offset%) 104 (rwork double-float rwork-%data% rwork-%offset%)) 105 (prog ((ncolm 0) (mf1 0) (lyhn 0) (lyhd 0) (lwtem 0) (lrtem 0) 106 (lja 0) (lia 0) (lf0 0) (lenrw 0) (leniw 0) (lenyht 0) (kgo 0) 107 (j 0) (irem 0) (ipgo 0) (ipflag 0) (imxer 0) (imul 0) (imax 0) 108 (iflag 0) (i2 0) (i1 0) (i 0) (w0 0.0d0) (sum 0.0d0) 109 (size 0.0d0) (tp 0.0d0) (tolsf 0.0d0) (tol 0.0d0) 110 (tnext 0.0d0) (tdist 0.0d0) (tcrit 0.0d0) (rtoli 0.0d0) 111 (rh 0.0d0) (hmx 0.0d0) (hmax 0.0d0) (h0 0.0d0) (ewti 0.0d0) 112 (big 0.0d0) (ayi 0.0d0) (atoli 0.0d0) (ihit nil) 113 (msg 114 (make-array '(60) 115 :element-type 'character 116 :initial-element #\ ))) 117 (declare (type (string 60) msg) 118 (type f2cl-lib:logical ihit) 119 (type (double-float) atoli ayi big ewti h0 hmax hmx rh 120 rtoli tcrit tdist tnext tol tolsf tp 121 size sum w0) 122 (type (f2cl-lib:integer4) i i1 i2 iflag imax imul imxer 123 ipflag ipgo irem j kgo lenyht 124 leniw lenrw lf0 lia lja lrtem 125 lwtem lyhd lyhn mf1 ncolm)) 126 (if (or (< istate 1) (> istate 3)) (go label601)) 127 (if (or (< itask 1) (> itask 5)) (go label602)) 128 (if (= istate 1) (go label10)) 129 (if (= init 0) (go label603)) 130 (if (= istate 2) (go label200)) 131 (go label20) 132 label10 133 (setf init 0) 134 (if (= tout t$) (go end_label)) 135 label20 136 (if (<= (f2cl-lib:fref neq-%data% (1) ((1 *)) neq-%offset%) 0) 137 (go label604)) 138 (if (= istate 1) (go label25)) 139 (if (> (f2cl-lib:fref neq-%data% (1) ((1 *)) neq-%offset%) n) 140 (go label605)) 141 label25 142 (setf n (f2cl-lib:fref neq-%data% (1) ((1 *)) neq-%offset%)) 143 (if (or (< itol 1) (> itol 4)) (go label606)) 144 (if (or (< iopt 0) (> iopt 1)) (go label607)) 145 (setf moss (the f2cl-lib:integer4 (truncate mf 100))) 146 (setf mf1 (f2cl-lib:int-sub mf (f2cl-lib:int-mul 100 moss))) 147 (setf meth (the f2cl-lib:integer4 (truncate mf1 10))) 148 (setf miter (f2cl-lib:int-sub mf1 (f2cl-lib:int-mul 10 meth))) 149 (if (or (< moss 0) (> moss 2)) (go label608)) 150 (if (or (< meth 1) (> meth 2)) (go label608)) 151 (if (or (< miter 0) (> miter 3)) (go label608)) 152 (if (or (= miter 0) (= miter 3)) (setf moss 0)) 153 (if (= iopt 1) (go label40)) 154 (setf maxord (f2cl-lib:fref mord (meth) ((1 2)))) 155 (setf mxstep mxstp0) 156 (setf mxhnil mxhnl0) 157 (if (= istate 1) (setf h0 0.0d0)) 158 (setf hmxi 0.0d0) 159 (setf hmin 0.0d0) 160 (setf seth 0.0d0) 161 (go label60) 162 label40 163 (setf maxord 164 (f2cl-lib:fref iwork-%data% (5) ((1 liw)) iwork-%offset%)) 165 (if (< maxord 0) (go label611)) 166 (if (= maxord 0) (setf maxord 100)) 167 (setf maxord 168 (min (the f2cl-lib:integer4 maxord) 169 (the f2cl-lib:integer4 170 (f2cl-lib:fref mord (meth) ((1 2)))))) 171 (setf mxstep 172 (f2cl-lib:fref iwork-%data% (6) ((1 liw)) iwork-%offset%)) 173 (if (< mxstep 0) (go label612)) 174 (if (= mxstep 0) (setf mxstep mxstp0)) 175 (setf mxhnil 176 (f2cl-lib:fref iwork-%data% (7) ((1 liw)) iwork-%offset%)) 177 (if (< mxhnil 0) (go label613)) 178 (if (= mxhnil 0) (setf mxhnil mxhnl0)) 179 (if (/= istate 1) (go label50)) 180 (setf h0 (f2cl-lib:fref rwork-%data% (5) ((1 lrw)) rwork-%offset%)) 181 (if (< (* (- tout t$) h0) 0.0d0) (go label614)) 182 label50 183 (setf hmax 184 (f2cl-lib:fref rwork-%data% (6) ((1 lrw)) rwork-%offset%)) 185 (if (< hmax 0.0d0) (go label615)) 186 (setf hmxi 0.0d0) 187 (if (> hmax 0.0d0) (setf hmxi (/ 1.0d0 hmax))) 188 (setf hmin 189 (f2cl-lib:fref rwork-%data% (7) ((1 lrw)) rwork-%offset%)) 190 (if (< hmin 0.0d0) (go label616)) 191 (setf seth 192 (f2cl-lib:fref rwork-%data% (8) ((1 lrw)) rwork-%offset%)) 193 (if (< seth 0.0d0) (go label609)) 194 label60 195 (setf rtoli (f2cl-lib:fref rtol-%data% (1) ((1 *)) rtol-%offset%)) 196 (setf atoli (f2cl-lib:fref atol-%data% (1) ((1 *)) atol-%offset%)) 197 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 198 ((> i n) nil) 199 (tagbody 200 (if (>= itol 3) 201 (setf rtoli 202 (f2cl-lib:fref rtol-%data% 203 (i) 204 ((1 *)) 205 rtol-%offset%))) 206 (if (or (= itol 2) (= itol 4)) 207 (setf atoli 208 (f2cl-lib:fref atol-%data% 209 (i) 210 ((1 *)) 211 atol-%offset%))) 212 (if (< rtoli 0.0d0) (go label619)) 213 (if (< atoli 0.0d0) (go label620)) 214 label65)) 215 (setf lrat lenrat) 216 (if (= istate 1) (setf nyh n)) 217 (setf lwmin 0) 218 (if (= miter 1) 219 (setf lwmin 220 (+ (f2cl-lib:int-mul 4 n) 221 (the f2cl-lib:integer4 (truncate (* 10 n) lrat))))) 222 (if (= miter 2) 223 (setf lwmin 224 (+ (f2cl-lib:int-mul 4 n) 225 (the f2cl-lib:integer4 (truncate (* 11 n) lrat))))) 226 (if (= miter 3) (setf lwmin (f2cl-lib:int-add n 2))) 227 (setf lenyh (f2cl-lib:int-mul (f2cl-lib:int-add maxord 1) nyh)) 228 (setf lrest (f2cl-lib:int-add lenyh (f2cl-lib:int-mul 3 n))) 229 (setf lenrw (f2cl-lib:int-add 20 lwmin lrest)) 230 (setf (f2cl-lib:fref iwork-%data% (17) ((1 liw)) iwork-%offset%) 231 lenrw) 232 (setf leniw 30) 233 (if (and (= moss 0) (/= miter 0) (/= miter 3)) 234 (setf leniw (f2cl-lib:int-add leniw n 1))) 235 (setf (f2cl-lib:fref iwork-%data% (18) ((1 liw)) iwork-%offset%) 236 leniw) 237 (if (> lenrw lrw) (go label617)) 238 (if (> leniw liw) (go label618)) 239 (setf lia 31) 240 (if (and (= moss 0) (/= miter 0) (/= miter 3)) 241 (setf leniw 242 (f2cl-lib:int-sub 243 (f2cl-lib:int-add leniw 244 (f2cl-lib:fref iwork-%data% 245 ((f2cl-lib:int-add 246 lia 247 n)) 248 ((1 liw)) 249 iwork-%offset%)) 250 1))) 251 (setf (f2cl-lib:fref iwork-%data% (18) ((1 liw)) iwork-%offset%) 252 leniw) 253 (if (> leniw liw) (go label618)) 254 (setf lja (f2cl-lib:int-add lia n 1)) 255 (setf lia 256 (min (the f2cl-lib:integer4 lia) 257 (the f2cl-lib:integer4 liw))) 258 (setf lja 259 (min (the f2cl-lib:integer4 lja) 260 (the f2cl-lib:integer4 liw))) 261 (setf lwm 21) 262 (if (= istate 1) (setf nq 1)) 263 (setf ncolm 264 (min (the f2cl-lib:integer4 (f2cl-lib:int-add nq 1)) 265 (the f2cl-lib:integer4 (f2cl-lib:int-add maxord 2)))) 266 (setf lenyhm (f2cl-lib:int-mul ncolm nyh)) 267 (setf lenyht lenyh) 268 (if (or (= miter 1) (= miter 2)) (setf lenyht lenyhm)) 269 (setf imul 2) 270 (if (= istate 3) (setf imul moss)) 271 (if (= moss 2) (setf imul 3)) 272 (setf lrtem (f2cl-lib:int-add lenyht (f2cl-lib:int-mul imul n))) 273 (setf lwtem lwmin) 274 (if (or (= miter 1) (= miter 2)) 275 (setf lwtem (f2cl-lib:int-sub lrw 20 lrtem))) 276 (setf lenwk lwtem) 277 (setf lyhn (f2cl-lib:int-add lwm lwtem)) 278 (setf lsavf (f2cl-lib:int-add lyhn lenyht)) 279 (setf lewt (f2cl-lib:int-add lsavf n)) 280 (setf lacor (f2cl-lib:int-add lewt n)) 281 (setf istatc istate) 282 (if (= istate 1) (go label100)) 283 (setf lyhd (f2cl-lib:int-sub lyh lyhn)) 284 (setf imax (f2cl-lib:int-add (f2cl-lib:int-sub lyhn 1) lenyhm)) 285 (cond 286 ((< lyhd 0) 287 (f2cl-lib:fdo (i lyhn (f2cl-lib:int-add i 1)) 288 ((> i imax) nil) 289 (tagbody 290 (setf j (f2cl-lib:int-sub (f2cl-lib:int-add imax lyhn) i)) 291 label72 292 (setf (f2cl-lib:fref rwork-%data% 293 (j) 294 ((1 lrw)) 295 rwork-%offset%) 296 (f2cl-lib:fref rwork-%data% 297 ((f2cl-lib:int-add j lyhd)) 298 ((1 lrw)) 299 rwork-%offset%)))))) 300 (cond 301 ((> lyhd 0) 302 (f2cl-lib:fdo (i lyhn (f2cl-lib:int-add i 1)) 303 ((> i imax) nil) 304 (tagbody 305 label76 306 (setf (f2cl-lib:fref rwork-%data% 307 (i) 308 ((1 lrw)) 309 rwork-%offset%) 310 (f2cl-lib:fref rwork-%data% 311 ((f2cl-lib:int-add i lyhd)) 312 ((1 lrw)) 313 rwork-%offset%)))))) 314 label80 315 (setf lyh lyhn) 316 (setf (f2cl-lib:fref iwork-%data% (22) ((1 liw)) iwork-%offset%) 317 lyh) 318 (if (or (= miter 0) (= miter 3)) (go label92)) 319 (if (/= moss 2) (go label85)) 320 (dewset n itol rtol atol 321 (f2cl-lib:array-slice rwork-%data% 322 double-float 323 (lyh) 324 ((1 lrw)) 325 rwork-%offset%) 326 (f2cl-lib:array-slice rwork-%data% 327 double-float 328 (lewt) 329 ((1 lrw)) 330 rwork-%offset%)) 331 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 332 ((> i n) nil) 333 (tagbody 334 (if 335 (<= 336 (f2cl-lib:fref rwork-%data% 337 ((f2cl-lib:int-sub (f2cl-lib:int-add i lewt) 338 1)) 339 ((1 lrw)) 340 rwork-%offset%) 341 0.0d0) 342 (go label621)) 343 label82 344 (setf (f2cl-lib:fref rwork-%data% 345 ((f2cl-lib:int-sub 346 (f2cl-lib:int-add i lewt) 347 1)) 348 ((1 lrw)) 349 rwork-%offset%) 350 (/ 1.0d0 351 (f2cl-lib:fref rwork-%data% 352 ((f2cl-lib:int-sub 353 (f2cl-lib:int-add i lewt) 354 1)) 355 ((1 lrw)) 356 rwork-%offset%))))) 357 label85 358 (setf lsavf 359 (min (the f2cl-lib:integer4 lsavf) 360 (the f2cl-lib:integer4 lrw))) 361 (setf lewt 362 (min (the f2cl-lib:integer4 lewt) 363 (the f2cl-lib:integer4 lrw))) 364 (setf lacor 365 (min (the f2cl-lib:integer4 lacor) 366 (the f2cl-lib:integer4 lrw))) 367 (multiple-value-bind 368 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7) 369 (diprep neq y rwork 370 (f2cl-lib:array-slice iwork-%data% 371 f2cl-lib:integer4 372 (lia) 373 ((1 liw)) 374 iwork-%offset%) 375 (f2cl-lib:array-slice iwork-%data% 376 f2cl-lib:integer4 377 (lja) 378 ((1 liw)) 379 iwork-%offset%) 380 ipflag f jac) 381 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-6 var-7)) 382 (setf ipflag var-5)) 383 (setf lenrw 384 (f2cl-lib:int-add (f2cl-lib:int-sub lwm 1) lenwk lrest)) 385 (setf (f2cl-lib:fref iwork-%data% (17) ((1 liw)) iwork-%offset%) 386 lenrw) 387 (if (/= ipflag -1) 388 (setf (f2cl-lib:fref iwork-%data% 389 (23) 390 ((1 liw)) 391 iwork-%offset%) 392 ipian)) 393 (if (/= ipflag -1) 394 (setf (f2cl-lib:fref iwork-%data% 395 (24) 396 ((1 liw)) 397 iwork-%offset%) 398 ipjan)) 399 (setf ipgo (f2cl-lib:int-sub 1 ipflag)) 400 (f2cl-lib:computed-goto 401 (label90 label628 label629 label630 label631 label632 label633) 402 ipgo) 403 label90 404 (setf (f2cl-lib:fref iwork-%data% (22) ((1 liw)) iwork-%offset%) 405 lyh) 406 (if (> lenrw lrw) (go label617)) 407 label92 408 (setf jstart -1) 409 (if (= n nyh) (go label200)) 410 (setf i1 (f2cl-lib:int-add lyh (f2cl-lib:int-mul l nyh))) 411 (setf i2 412 (f2cl-lib:int-sub 413 (f2cl-lib:int-add lyh 414 (f2cl-lib:int-mul 415 (f2cl-lib:int-add maxord 1) 416 nyh)) 417 1)) 418 (if (> i1 i2) (go label200)) 419 (f2cl-lib:fdo (i i1 (f2cl-lib:int-add i 1)) 420 ((> i i2) nil) 421 (tagbody 422 label95 423 (setf (f2cl-lib:fref rwork-%data% (i) ((1 lrw)) rwork-%offset%) 424 0.0d0))) 425 (go label200) 426 label100 427 (setf lyh lyhn) 428 (setf (f2cl-lib:fref iwork-%data% (22) ((1 liw)) iwork-%offset%) 429 lyh) 430 (setf tn t$) 431 (setf nst 0) 432 (setf h 1.0d0) 433 (setf nnz 0) 434 (setf ngp 0) 435 (setf nzl 0) 436 (setf nzu 0) 437 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 438 ((> i n) nil) 439 (tagbody 440 label105 441 (setf (f2cl-lib:fref rwork-%data% 442 ((f2cl-lib:int-sub 443 (f2cl-lib:int-add i lyh) 444 1)) 445 ((1 lrw)) 446 rwork-%offset%) 447 (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)))) 448 (setf lf0 (f2cl-lib:int-add lyh nyh)) 449 (multiple-value-bind (var-0 var-1 var-2 var-3) 450 (funcall f 451 neq 452 t$ 453 y 454 (f2cl-lib:array-slice rwork-%data% 455 double-float 456 (lf0) 457 ((1 lrw)) 458 rwork-%offset%)) 459 (declare (ignore var-0 var-2 var-3)) 460 (when var-1 461 (setf t$ var-1))) 462 (setf nfe 1) 463 (dewset n itol rtol atol 464 (f2cl-lib:array-slice rwork-%data% 465 double-float 466 (lyh) 467 ((1 lrw)) 468 rwork-%offset%) 469 (f2cl-lib:array-slice rwork-%data% 470 double-float 471 (lewt) 472 ((1 lrw)) 473 rwork-%offset%)) 474 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 475 ((> i n) nil) 476 (tagbody 477 (if 478 (<= 479 (f2cl-lib:fref rwork-%data% 480 ((f2cl-lib:int-sub (f2cl-lib:int-add i lewt) 481 1)) 482 ((1 lrw)) 483 rwork-%offset%) 484 0.0d0) 485 (go label621)) 486 label110 487 (setf (f2cl-lib:fref rwork-%data% 488 ((f2cl-lib:int-sub 489 (f2cl-lib:int-add i lewt) 490 1)) 491 ((1 lrw)) 492 rwork-%offset%) 493 (/ 1.0d0 494 (f2cl-lib:fref rwork-%data% 495 ((f2cl-lib:int-sub 496 (f2cl-lib:int-add i lewt) 497 1)) 498 ((1 lrw)) 499 rwork-%offset%))))) 500 (if (or (= miter 0) (= miter 3)) (go label120)) 501 (setf lacor 502 (min (the f2cl-lib:integer4 lacor) 503 (the f2cl-lib:integer4 lrw))) 504 (multiple-value-bind 505 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7) 506 (diprep neq y rwork 507 (f2cl-lib:array-slice iwork-%data% 508 f2cl-lib:integer4 509 (lia) 510 ((1 liw)) 511 iwork-%offset%) 512 (f2cl-lib:array-slice iwork-%data% 513 f2cl-lib:integer4 514 (lja) 515 ((1 liw)) 516 iwork-%offset%) 517 ipflag f jac) 518 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-6 var-7)) 519 (setf ipflag var-5)) 520 (setf lenrw 521 (f2cl-lib:int-add (f2cl-lib:int-sub lwm 1) lenwk lrest)) 522 (setf (f2cl-lib:fref iwork-%data% (17) ((1 liw)) iwork-%offset%) 523 lenrw) 524 (if (/= ipflag -1) 525 (setf (f2cl-lib:fref iwork-%data% 526 (23) 527 ((1 liw)) 528 iwork-%offset%) 529 ipian)) 530 (if (/= ipflag -1) 531 (setf (f2cl-lib:fref iwork-%data% 532 (24) 533 ((1 liw)) 534 iwork-%offset%) 535 ipjan)) 536 (setf ipgo (f2cl-lib:int-sub 1 ipflag)) 537 (f2cl-lib:computed-goto 538 (label115 label628 label629 label630 label631 label632 label633) 539 ipgo) 540 label115 541 (setf (f2cl-lib:fref iwork-%data% (22) ((1 liw)) iwork-%offset%) 542 lyh) 543 (if (> lenrw lrw) (go label617)) 544 label120 545 (if (and (/= itask 4) (/= itask 5)) (go label125)) 546 (setf tcrit 547 (f2cl-lib:fref rwork-%data% (1) ((1 lrw)) rwork-%offset%)) 548 (if (< (* (- tcrit tout) (- tout t$)) 0.0d0) (go label625)) 549 (if (and (/= h0 0.0d0) (> (* (- (+ t$ h0) tcrit) h0) 0.0d0)) 550 (setf h0 (- tcrit t$))) 551 label125 552 (setf uround (dumach)) 553 (setf jstart 0) 554 (if (/= miter 0) 555 (setf (f2cl-lib:fref rwork-%data% 556 (lwm) 557 ((1 lrw)) 558 rwork-%offset%) 559 (f2cl-lib:fsqrt uround))) 560 (setf msbj 50) 561 (setf nslj 0) 562 (setf ccmxj 0.2d0) 563 (setf psmall (* 1000.0d0 uround)) 564 (setf rbig (/ 0.01d0 psmall)) 565 (setf nhnil 0) 566 (setf nje 0) 567 (setf nlu 0) 568 (setf nslast 0) 569 (setf hu 0.0d0) 570 (setf nqu 0) 571 (setf ccmax 0.3d0) 572 (setf maxcor 3) 573 (setf msbp 20) 574 (setf mxncf 10) 575 (setf lf0 (f2cl-lib:int-add lyh nyh)) 576 (if (/= h0 0.0d0) (go label180)) 577 (setf tdist (abs (- tout t$))) 578 (setf w0 (max (abs t$) (abs tout))) 579 (if (< tdist (* 2.0d0 uround w0)) (go label622)) 580 (setf tol (f2cl-lib:fref rtol-%data% (1) ((1 *)) rtol-%offset%)) 581 (if (<= itol 2) (go label140)) 582 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 583 ((> i n) nil) 584 (tagbody 585 label130 586 (setf tol 587 (max tol 588 (f2cl-lib:fref rtol-%data% 589 (i) 590 ((1 *)) 591 rtol-%offset%))))) 592 label140 593 (if (> tol 0.0d0) (go label160)) 594 (setf atoli (f2cl-lib:fref atol-%data% (1) ((1 *)) atol-%offset%)) 595 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 596 ((> i n) nil) 597 (tagbody 598 (if (or (= itol 2) (= itol 4)) 599 (setf atoli 600 (f2cl-lib:fref atol-%data% 601 (i) 602 ((1 *)) 603 atol-%offset%))) 604 (setf ayi 605 (abs (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%))) 606 (if (/= ayi 0.0d0) (setf tol (max tol (/ atoli ayi)))) 607 label150)) 608 label160 609 (setf tol (max tol (* 100.0d0 uround))) 610 (setf tol (min tol 0.001d0)) 611 (setf sum 612 (dvnorm n 613 (f2cl-lib:array-slice rwork-%data% 614 double-float 615 (lf0) 616 ((1 lrw)) 617 rwork-%offset%) 618 (f2cl-lib:array-slice rwork-%data% 619 double-float 620 (lewt) 621 ((1 lrw)) 622 rwork-%offset%))) 623 (setf sum (+ (/ 1.0d0 (* tol w0 w0)) (* tol (expt sum 2)))) 624 (setf h0 (/ 1.0d0 (f2cl-lib:fsqrt sum))) 625 (setf h0 (min h0 tdist)) 626 (setf h0 (f2cl-lib:sign h0 (- tout t$))) 627 label180 628 (setf rh (* (abs h0) hmxi)) 629 (if (> rh 1.0d0) (setf h0 (/ h0 rh))) 630 (setf h h0) 631 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 632 ((> i n) nil) 633 (tagbody 634 label190 635 (setf (f2cl-lib:fref rwork-%data% 636 ((f2cl-lib:int-sub 637 (f2cl-lib:int-add i lf0) 638 1)) 639 ((1 lrw)) 640 rwork-%offset%) 641 (* h0 642 (f2cl-lib:fref rwork-%data% 643 ((f2cl-lib:int-sub 644 (f2cl-lib:int-add i lf0) 645 1)) 646 ((1 lrw)) 647 rwork-%offset%))))) 648 (go label270) 649 label200 650 (setf nslast nst) 651 (f2cl-lib:computed-goto 652 (label210 label250 label220 label230 label240) 653 itask) 654 label210 655 (if (< (* (- tn tout) h) 0.0d0) (go label250)) 656 (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5) 657 (dintdy tout 0 658 (f2cl-lib:array-slice rwork-%data% 659 double-float 660 (lyh) 661 ((1 lrw)) 662 rwork-%offset%) 663 nyh y iflag) 664 (declare (ignore var-0 var-1 var-2 var-3 var-4)) 665 (setf iflag var-5)) 666 (if (/= iflag 0) (go label627)) 667 (setf t$ tout) 668 (go label420) 669 label220 670 (setf tp (- tn (* hu (+ 1.0d0 (* 100.0d0 uround))))) 671 (if (> (* (- tp tout) h) 0.0d0) (go label623)) 672 (if (< (* (- tn tout) h) 0.0d0) (go label250)) 673 (go label400) 674 label230 675 (setf tcrit 676 (f2cl-lib:fref rwork-%data% (1) ((1 lrw)) rwork-%offset%)) 677 (if (> (* (- tn tcrit) h) 0.0d0) (go label624)) 678 (if (< (* (- tcrit tout) h) 0.0d0) (go label625)) 679 (if (< (* (- tn tout) h) 0.0d0) (go label245)) 680 (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5) 681 (dintdy tout 0 682 (f2cl-lib:array-slice rwork-%data% 683 double-float 684 (lyh) 685 ((1 lrw)) 686 rwork-%offset%) 687 nyh y iflag) 688 (declare (ignore var-0 var-1 var-2 var-3 var-4)) 689 (setf iflag var-5)) 690 (if (/= iflag 0) (go label627)) 691 (setf t$ tout) 692 (go label420) 693 label240 694 (setf tcrit 695 (f2cl-lib:fref rwork-%data% (1) ((1 lrw)) rwork-%offset%)) 696 (if (> (* (- tn tcrit) h) 0.0d0) (go label624)) 697 label245 698 (setf hmx (+ (abs tn) (abs h))) 699 (setf ihit (<= (abs (- tn tcrit)) (* 100.0d0 uround hmx))) 700 (if ihit (go label400)) 701 (setf tnext (+ tn (* h (+ 1.0d0 (* 4.0d0 uround))))) 702 (if (<= (* (- tnext tcrit) h) 0.0d0) (go label250)) 703 (setf h (* (- tcrit tn) (- 1.0d0 (* 4.0d0 uround)))) 704 (if (= istate 2) (setf jstart -2)) 705 label250 706 (if (>= (f2cl-lib:int-sub nst nslast) mxstep) (go label500)) 707 (dewset n itol rtol atol 708 (f2cl-lib:array-slice rwork-%data% 709 double-float 710 (lyh) 711 ((1 lrw)) 712 rwork-%offset%) 713 (f2cl-lib:array-slice rwork-%data% 714 double-float 715 (lewt) 716 ((1 lrw)) 717 rwork-%offset%)) 718 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 719 ((> i n) nil) 720 (tagbody 721 (if 722 (<= 723 (f2cl-lib:fref rwork-%data% 724 ((f2cl-lib:int-sub (f2cl-lib:int-add i lewt) 725 1)) 726 ((1 lrw)) 727 rwork-%offset%) 728 0.0d0) 729 (go label510)) 730 label260 731 (setf (f2cl-lib:fref rwork-%data% 732 ((f2cl-lib:int-sub 733 (f2cl-lib:int-add i lewt) 734 1)) 735 ((1 lrw)) 736 rwork-%offset%) 737 (/ 1.0d0 738 (f2cl-lib:fref rwork-%data% 739 ((f2cl-lib:int-sub 740 (f2cl-lib:int-add i lewt) 741 1)) 742 ((1 lrw)) 743 rwork-%offset%))))) 744 label270 745 (setf tolsf 746 (* uround 747 (dvnorm n 748 (f2cl-lib:array-slice rwork-%data% 749 double-float 750 (lyh) 751 ((1 lrw)) 752 rwork-%offset%) 753 (f2cl-lib:array-slice rwork-%data% 754 double-float 755 (lewt) 756 ((1 lrw)) 757 rwork-%offset%)))) 758 (if (<= tolsf 1.0d0) (go label280)) 759 (setf tolsf (* tolsf 2.0d0)) 760 (if (= nst 0) (go label626)) 761 (go label520) 762 label280 763 (if (/= (+ tn h) tn) (go label290)) 764 (setf nhnil (f2cl-lib:int-add nhnil 1)) 765 (if (> nhnil mxhnil) (go label290)) 766 (f2cl-lib:f2cl-set-string msg 767 "DLSODES- Warning..Internal T (=R1) and H (=R2) are" 768 (string 60)) 769 (xerrwd msg 50 101 0 0 0 0 0 0.0d0 0.0d0) 770 (f2cl-lib:f2cl-set-string msg 771 " such that in the machine, T + H = T on the next step " 772 (string 60)) 773 (xerrwd msg 60 101 0 0 0 0 0 0.0d0 0.0d0) 774 (f2cl-lib:f2cl-set-string msg 775 " (H = step size). Solver will continue anyway." 776 (string 60)) 777 (xerrwd msg 50 101 0 0 0 0 2 tn h) 778 (if (< nhnil mxhnil) (go label290)) 779 (f2cl-lib:f2cl-set-string msg 780 "DLSODES- Above warning has been issued I1 times. " 781 (string 60)) 782 (xerrwd msg 50 102 0 0 0 0 0 0.0d0 0.0d0) 783 (f2cl-lib:f2cl-set-string msg 784 " It will not be issued again for this problem." 785 (string 60)) 786 (xerrwd msg 50 102 0 1 mxhnil 0 0 0.0d0 0.0d0) 787 label290 788 (multiple-value-bind 789 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 790 var-10 var-11 var-12 var-13) 791 (dstode neq y 792 (f2cl-lib:array-slice rwork-%data% 793 double-float 794 (lyh) 795 ((1 lrw)) 796 rwork-%offset%) 797 nyh 798 (f2cl-lib:array-slice rwork-%data% 799 double-float 800 (lyh) 801 ((1 lrw)) 802 rwork-%offset%) 803 (f2cl-lib:array-slice rwork-%data% 804 double-float 805 (lewt) 806 ((1 lrw)) 807 rwork-%offset%) 808 (f2cl-lib:array-slice rwork-%data% 809 double-float 810 (lsavf) 811 ((1 lrw)) 812 rwork-%offset%) 813 (f2cl-lib:array-slice rwork-%data% 814 double-float 815 (lacor) 816 ((1 lrw)) 817 rwork-%offset%) 818 (f2cl-lib:array-slice rwork-%data% 819 double-float 820 (lwm) 821 ((1 lrw)) 822 rwork-%offset%) 823 (f2cl-lib:array-slice rwork-%data% 824 double-float 825 (lwm) 826 ((1 lrw)) 827 rwork-%offset%) 828 f jac #'dprjs #'dsolss) 829 (declare (ignore var-0 var-1 var-2 var-4 var-5 var-6 var-7 var-8 830 var-9 var-10 var-11 var-12 var-13)) 831 (setf nyh var-3)) 832 (setf kgo (f2cl-lib:int-sub 1 kflag)) 833 (f2cl-lib:computed-goto (label300 label530 label540 label550) kgo) 834 label300 835 (setf init 1) 836 (f2cl-lib:computed-goto 837 (label310 label400 label330 label340 label350) 838 itask) 839 label310 840 (if (< (* (- tn tout) h) 0.0d0) (go label250)) 841 (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5) 842 (dintdy tout 0 843 (f2cl-lib:array-slice rwork-%data% 844 double-float 845 (lyh) 846 ((1 lrw)) 847 rwork-%offset%) 848 nyh y iflag) 849 (declare (ignore var-0 var-1 var-2 var-3 var-4)) 850 (setf iflag var-5)) 851 (setf t$ tout) 852 (go label420) 853 label330 854 (if (>= (* (- tn tout) h) 0.0d0) (go label400)) 855 (go label250) 856 label340 857 (if (< (* (- tn tout) h) 0.0d0) (go label345)) 858 (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5) 859 (dintdy tout 0 860 (f2cl-lib:array-slice rwork-%data% 861 double-float 862 (lyh) 863 ((1 lrw)) 864 rwork-%offset%) 865 nyh y iflag) 866 (declare (ignore var-0 var-1 var-2 var-3 var-4)) 867 (setf iflag var-5)) 868 (setf t$ tout) 869 (go label420) 870 label345 871 (setf hmx (+ (abs tn) (abs h))) 872 (setf ihit (<= (abs (- tn tcrit)) (* 100.0d0 uround hmx))) 873 (if ihit (go label400)) 874 (setf tnext (+ tn (* h (+ 1.0d0 (* 4.0d0 uround))))) 875 (if (<= (* (- tnext tcrit) h) 0.0d0) (go label250)) 876 (setf h (* (- tcrit tn) (- 1.0d0 (* 4.0d0 uround)))) 877 (setf jstart -2) 878 (go label250) 879 label350 880 (setf hmx (+ (abs tn) (abs h))) 881 (setf ihit (<= (abs (- tn tcrit)) (* 100.0d0 uround hmx))) 882 label400 883 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 884 ((> i n) nil) 885 (tagbody 886 label410 887 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%) 888 (f2cl-lib:fref rwork-%data% 889 ((f2cl-lib:int-sub 890 (f2cl-lib:int-add i lyh) 891 1)) 892 ((1 lrw)) 893 rwork-%offset%)))) 894 (setf t$ tn) 895 (if (and (/= itask 4) (/= itask 5)) (go label420)) 896 (if ihit (setf t$ tcrit)) 897 label420 898 (setf istate 2) 899 (setf (f2cl-lib:fref rwork-%data% (11) ((1 lrw)) rwork-%offset%) 900 hu) 901 (setf (f2cl-lib:fref rwork-%data% (12) ((1 lrw)) rwork-%offset%) h) 902 (setf (f2cl-lib:fref rwork-%data% (13) ((1 lrw)) rwork-%offset%) 903 tn) 904 (setf (f2cl-lib:fref iwork-%data% (11) ((1 liw)) iwork-%offset%) 905 nst) 906 (setf (f2cl-lib:fref iwork-%data% (12) ((1 liw)) iwork-%offset%) 907 nfe) 908 (setf (f2cl-lib:fref iwork-%data% (13) ((1 liw)) iwork-%offset%) 909 nje) 910 (setf (f2cl-lib:fref iwork-%data% (14) ((1 liw)) iwork-%offset%) 911 nqu) 912 (setf (f2cl-lib:fref iwork-%data% (15) ((1 liw)) iwork-%offset%) 913 nq) 914 (setf (f2cl-lib:fref iwork-%data% (19) ((1 liw)) iwork-%offset%) 915 nnz) 916 (setf (f2cl-lib:fref iwork-%data% (20) ((1 liw)) iwork-%offset%) 917 ngp) 918 (setf (f2cl-lib:fref iwork-%data% (21) ((1 liw)) iwork-%offset%) 919 nlu) 920 (setf (f2cl-lib:fref iwork-%data% (25) ((1 liw)) iwork-%offset%) 921 nzl) 922 (setf (f2cl-lib:fref iwork-%data% (26) ((1 liw)) iwork-%offset%) 923 nzu) 924 (go end_label) 925 label500 926 (f2cl-lib:f2cl-set-string msg 927 "DLSODES- At current T (=R1), MXSTEP (=I1) steps " 928 (string 60)) 929 (xerrwd msg 50 201 0 0 0 0 0 0.0d0 0.0d0) 930 (f2cl-lib:f2cl-set-string msg 931 " taken on this call before reaching TOUT " 932 (string 60)) 933 (xerrwd msg 50 201 0 1 mxstep 0 1 tn 0.0d0) 934 (setf istate -1) 935 (go label580) 936 label510 937 (setf ewti 938 (f2cl-lib:fref rwork-%data% 939 ((f2cl-lib:int-sub (f2cl-lib:int-add lewt i) 940 1)) 941 ((1 lrw)) 942 rwork-%offset%)) 943 (f2cl-lib:f2cl-set-string msg 944 "DLSODES- At T (=R1), EWT(I1) has become R2 <= 0." 945 (string 60)) 946 (xerrwd msg 50 202 0 1 i 0 2 tn ewti) 947 (setf istate -6) 948 (go label580) 949 label520 950 (f2cl-lib:f2cl-set-string msg 951 "DLSODES- At T (=R1), too much accuracy requested " 952 (string 60)) 953 (xerrwd msg 50 203 0 0 0 0 0 0.0d0 0.0d0) 954 (f2cl-lib:f2cl-set-string msg 955 " for precision of machine.. See TOLSF (=R2) " 956 (string 60)) 957 (xerrwd msg 50 203 0 0 0 0 2 tn tolsf) 958 (setf (f2cl-lib:fref rwork-%data% (14) ((1 lrw)) rwork-%offset%) 959 tolsf) 960 (setf istate -2) 961 (go label580) 962 label530 963 (f2cl-lib:f2cl-set-string msg 964 "DLSODES- At T(=R1) and step size H(=R2), the error" 965 (string 60)) 966 (xerrwd msg 50 204 0 0 0 0 0 0.0d0 0.0d0) 967 (f2cl-lib:f2cl-set-string msg 968 " test failed repeatedly or with ABS(H) = HMIN" 969 (string 60)) 970 (xerrwd msg 50 204 0 0 0 0 2 tn h) 971 (setf istate -4) 972 (go label560) 973 label540 974 (f2cl-lib:f2cl-set-string msg 975 "DLSODES- At T (=R1) and step size H (=R2), the " 976 (string 60)) 977 (xerrwd msg 50 205 0 0 0 0 0 0.0d0 0.0d0) 978 (f2cl-lib:f2cl-set-string msg 979 " corrector convergence failed repeatedly " 980 (string 60)) 981 (xerrwd msg 50 205 0 0 0 0 0 0.0d0 0.0d0) 982 (f2cl-lib:f2cl-set-string msg 983 " or with ABS(H) = HMIN " 984 (string 60)) 985 (xerrwd msg 30 205 0 0 0 0 2 tn h) 986 (setf istate -5) 987 (go label560) 988 label550 989 (f2cl-lib:f2cl-set-string msg 990 "DLSODES- At T (=R1) and step size H (=R2), a fatal" 991 (string 60)) 992 (xerrwd msg 50 207 0 0 0 0 0 0.0d0 0.0d0) 993 (f2cl-lib:f2cl-set-string msg 994 " error flag was returned by CDRV (by way of " 995 (string 60)) 996 (xerrwd msg 50 207 0 0 0 0 0 0.0d0 0.0d0) 997 (f2cl-lib:f2cl-set-string msg 998 " Subroutine DPRJS or DSOLSS) " 999 (string 60)) 1000 (xerrwd msg 40 207 0 0 0 0 2 tn h) 1001 (setf istate -7) 1002 (go label580) 1003 label560 1004 (setf big 0.0d0) 1005 (setf imxer 1) 1006 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 1007 ((> i n) nil) 1008 (tagbody 1009 (setf size 1010 (abs 1011 (* 1012 (f2cl-lib:fref rwork-%data% 1013 ((f2cl-lib:int-sub 1014 (f2cl-lib:int-add i lacor) 1015 1)) 1016 ((1 lrw)) 1017 rwork-%offset%) 1018 (f2cl-lib:fref rwork-%data% 1019 ((f2cl-lib:int-sub 1020 (f2cl-lib:int-add i lewt) 1021 1)) 1022 ((1 lrw)) 1023 rwork-%offset%)))) 1024 (if (>= big size) (go label570)) 1025 (setf big size) 1026 (setf imxer i) 1027 label570)) 1028 (setf (f2cl-lib:fref iwork-%data% (16) ((1 liw)) iwork-%offset%) 1029 imxer) 1030 label580 1031 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 1032 ((> i n) nil) 1033 (tagbody 1034 label590 1035 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%) 1036 (f2cl-lib:fref rwork-%data% 1037 ((f2cl-lib:int-sub 1038 (f2cl-lib:int-add i lyh) 1039 1)) 1040 ((1 lrw)) 1041 rwork-%offset%)))) 1042 (setf t$ tn) 1043 (setf (f2cl-lib:fref rwork-%data% (11) ((1 lrw)) rwork-%offset%) 1044 hu) 1045 (setf (f2cl-lib:fref rwork-%data% (12) ((1 lrw)) rwork-%offset%) h) 1046 (setf (f2cl-lib:fref rwork-%data% (13) ((1 lrw)) rwork-%offset%) 1047 tn) 1048 (setf (f2cl-lib:fref iwork-%data% (11) ((1 liw)) iwork-%offset%) 1049 nst) 1050 (setf (f2cl-lib:fref iwork-%data% (12) ((1 liw)) iwork-%offset%) 1051 nfe) 1052 (setf (f2cl-lib:fref iwork-%data% (13) ((1 liw)) iwork-%offset%) 1053 nje) 1054 (setf (f2cl-lib:fref iwork-%data% (14) ((1 liw)) iwork-%offset%) 1055 nqu) 1056 (setf (f2cl-lib:fref iwork-%data% (15) ((1 liw)) iwork-%offset%) 1057 nq) 1058 (setf (f2cl-lib:fref iwork-%data% (19) ((1 liw)) iwork-%offset%) 1059 nnz) 1060 (setf (f2cl-lib:fref iwork-%data% (20) ((1 liw)) iwork-%offset%) 1061 ngp) 1062 (setf (f2cl-lib:fref iwork-%data% (21) ((1 liw)) iwork-%offset%) 1063 nlu) 1064 (setf (f2cl-lib:fref iwork-%data% (25) ((1 liw)) iwork-%offset%) 1065 nzl) 1066 (setf (f2cl-lib:fref iwork-%data% (26) ((1 liw)) iwork-%offset%) 1067 nzu) 1068 (go end_label) 1069 label601 1070 (f2cl-lib:f2cl-set-string msg 1071 "DLSODES- ISTATE (=I1) illegal." 1072 (string 60)) 1073 (xerrwd msg 30 1 0 1 istate 0 0 0.0d0 0.0d0) 1074 (if (< istate 0) (go label800)) 1075 (go label700) 1076 label602 1077 (f2cl-lib:f2cl-set-string msg 1078 "DLSODES- ITASK (=I1) illegal. " 1079 (string 60)) 1080 (xerrwd msg 30 2 0 1 itask 0 0 0.0d0 0.0d0) 1081 (go label700) 1082 label603 1083 (f2cl-lib:f2cl-set-string msg 1084 "DLSODES- ISTATE > 1 but DLSODES not initialized. " 1085 (string 60)) 1086 (xerrwd msg 50 3 0 0 0 0 0 0.0d0 0.0d0) 1087 (go label700) 1088 label604 1089 (f2cl-lib:f2cl-set-string msg 1090 "DLSODES- NEQ (=I1) < 1 " 1091 (string 60)) 1092 (xerrwd msg 30 4 0 1 1093 (f2cl-lib:fref neq-%data% (1) ((1 *)) neq-%offset%) 0 0 0.0d0 1094 0.0d0) 1095 (go label700) 1096 label605 1097 (f2cl-lib:f2cl-set-string msg 1098 "DLSODES- ISTATE = 3 and NEQ increased (I1 to I2). " 1099 (string 60)) 1100 (xerrwd msg 50 5 0 2 n 1101 (f2cl-lib:fref neq-%data% (1) ((1 *)) neq-%offset%) 0 0.0d0 0.0d0) 1102 (go label700) 1103 label606 1104 (f2cl-lib:f2cl-set-string msg 1105 "DLSODES- ITOL (=I1) illegal. " 1106 (string 60)) 1107 (xerrwd msg 30 6 0 1 itol 0 0 0.0d0 0.0d0) 1108 (go label700) 1109 label607 1110 (f2cl-lib:f2cl-set-string msg 1111 "DLSODES- IOPT (=I1) illegal. " 1112 (string 60)) 1113 (xerrwd msg 30 7 0 1 iopt 0 0 0.0d0 0.0d0) 1114 (go label700) 1115 label608 1116 (f2cl-lib:f2cl-set-string msg 1117 "DLSODES- MF (=I1) illegal. " 1118 (string 60)) 1119 (xerrwd msg 30 8 0 1 mf 0 0 0.0d0 0.0d0) 1120 (go label700) 1121 label609 1122 (f2cl-lib:f2cl-set-string msg 1123 "DLSODES- SETH (=R1) < 0.0 " 1124 (string 60)) 1125 (xerrwd msg 30 9 0 0 0 0 1 seth 0.0d0) 1126 (go label700) 1127 label611 1128 (f2cl-lib:f2cl-set-string msg 1129 "DLSODES- MAXORD (=I1) < 0 " 1130 (string 60)) 1131 (xerrwd msg 30 11 0 1 maxord 0 0 0.0d0 0.0d0) 1132 (go label700) 1133 label612 1134 (f2cl-lib:f2cl-set-string msg 1135 "DLSODES- MXSTEP (=I1) < 0 " 1136 (string 60)) 1137 (xerrwd msg 30 12 0 1 mxstep 0 0 0.0d0 0.0d0) 1138 (go label700) 1139 label613 1140 (f2cl-lib:f2cl-set-string msg 1141 "DLSODES- MXHNIL (=I1) < 0 " 1142 (string 60)) 1143 (xerrwd msg 30 13 0 1 mxhnil 0 0 0.0d0 0.0d0) 1144 (go label700) 1145 label614 1146 (f2cl-lib:f2cl-set-string msg 1147 "DLSODES- TOUT (=R1) behind T (=R2) " 1148 (string 60)) 1149 (xerrwd msg 40 14 0 0 0 0 2 tout t$) 1150 (f2cl-lib:f2cl-set-string msg 1151 " Integration direction is given by H0 (=R1) " 1152 (string 60)) 1153 (xerrwd msg 50 14 0 0 0 0 1 h0 0.0d0) 1154 (go label700) 1155 label615 1156 (f2cl-lib:f2cl-set-string msg 1157 "DLSODES- HMAX (=R1) < 0.0 " 1158 (string 60)) 1159 (xerrwd msg 30 15 0 0 0 0 1 hmax 0.0d0) 1160 (go label700) 1161 label616 1162 (f2cl-lib:f2cl-set-string msg 1163 "DLSODES- HMIN (=R1) < 0.0 " 1164 (string 60)) 1165 (xerrwd msg 30 16 0 0 0 0 1 hmin 0.0d0) 1166 (go label700) 1167 label617 1168 (f2cl-lib:f2cl-set-string msg 1169 "DLSODES- RWORK length is insufficient to proceed. " 1170 (string 60)) 1171 (xerrwd msg 50 17 0 0 0 0 0 0.0d0 0.0d0) 1172 (f2cl-lib:f2cl-set-string msg 1173 " Length needed is >= LENRW (=I1), exceeds LRW (=I2)" 1174 (string 60)) 1175 (xerrwd msg 60 17 0 2 lenrw lrw 0 0.0d0 0.0d0) 1176 (go label700) 1177 label618 1178 (f2cl-lib:f2cl-set-string msg 1179 "DLSODES- IWORK length is insufficient to proceed. " 1180 (string 60)) 1181 (xerrwd msg 50 18 0 0 0 0 0 0.0d0 0.0d0) 1182 (f2cl-lib:f2cl-set-string msg 1183 " Length needed is >= LENIW (=I1), exceeds LIW (=I2)" 1184 (string 60)) 1185 (xerrwd msg 60 18 0 2 leniw liw 0 0.0d0 0.0d0) 1186 (go label700) 1187 label619 1188 (f2cl-lib:f2cl-set-string msg 1189 "DLSODES- RTOL(I1) is R1 < 0.0 " 1190 (string 60)) 1191 (xerrwd msg 40 19 0 1 i 0 1 rtoli 0.0d0) 1192 (go label700) 1193 label620 1194 (f2cl-lib:f2cl-set-string msg 1195 "DLSODES- ATOL(I1) is R1 < 0.0 " 1196 (string 60)) 1197 (xerrwd msg 40 20 0 1 i 0 1 atoli 0.0d0) 1198 (go label700) 1199 label621 1200 (setf ewti 1201 (f2cl-lib:fref rwork-%data% 1202 ((f2cl-lib:int-sub (f2cl-lib:int-add lewt i) 1203 1)) 1204 ((1 lrw)) 1205 rwork-%offset%)) 1206 (f2cl-lib:f2cl-set-string msg 1207 "DLSODES- EWT(I1) is R1 <= 0.0 " 1208 (string 60)) 1209 (xerrwd msg 40 21 0 1 i 0 1 ewti 0.0d0) 1210 (go label700) 1211 label622 1212 (f2cl-lib:f2cl-set-string msg 1213 "DLSODES- TOUT(=R1) too close to T(=R2) to start integration." 1214 (string 60)) 1215 (xerrwd msg 60 22 0 0 0 0 2 tout t$) 1216 (go label700) 1217 label623 1218 (f2cl-lib:f2cl-set-string msg 1219 "DLSODES- ITASK = I1 and TOUT (=R1) behind TCUR - HU (= R2) " 1220 (string 60)) 1221 (xerrwd msg 60 23 0 1 itask 0 2 tout tp) 1222 (go label700) 1223 label624 1224 (f2cl-lib:f2cl-set-string msg 1225 "DLSODES- ITASK = 4 or 5 and TCRIT (=R1) behind TCUR (=R2) " 1226 (string 60)) 1227 (xerrwd msg 60 24 0 0 0 0 2 tcrit tn) 1228 (go label700) 1229 label625 1230 (f2cl-lib:f2cl-set-string msg 1231 "DLSODES- ITASK = 4 or 5 and TCRIT (=R1) behind TOUT (=R2) " 1232 (string 60)) 1233 (xerrwd msg 60 25 0 0 0 0 2 tcrit tout) 1234 (go label700) 1235 label626 1236 (f2cl-lib:f2cl-set-string msg 1237 "DLSODES- At start of problem, too much accuracy " 1238 (string 60)) 1239 (xerrwd msg 50 26 0 0 0 0 0 0.0d0 0.0d0) 1240 (f2cl-lib:f2cl-set-string msg 1241 " requested for precision of machine.. See TOLSF (=R1) " 1242 (string 60)) 1243 (xerrwd msg 60 26 0 0 0 0 1 tolsf 0.0d0) 1244 (setf (f2cl-lib:fref rwork-%data% (14) ((1 lrw)) rwork-%offset%) 1245 tolsf) 1246 (go label700) 1247 label627 1248 (f2cl-lib:f2cl-set-string msg 1249 "DLSODES- Trouble in DINTDY. ITASK = I1, TOUT = R1" 1250 (string 60)) 1251 (xerrwd msg 50 27 0 1 itask 0 1 tout 0.0d0) 1252 (go label700) 1253 label628 1254 (f2cl-lib:f2cl-set-string msg 1255 "DLSODES- RWORK length insufficient (for Subroutine DPREP). " 1256 (string 60)) 1257 (xerrwd msg 60 28 0 0 0 0 0 0.0d0 0.0d0) 1258 (f2cl-lib:f2cl-set-string msg 1259 " Length needed is >= LENRW (=I1), exceeds LRW (=I2)" 1260 (string 60)) 1261 (xerrwd msg 60 28 0 2 lenrw lrw 0 0.0d0 0.0d0) 1262 (go label700) 1263 label629 1264 (f2cl-lib:f2cl-set-string msg 1265 "DLSODES- RWORK length insufficient (for Subroutine JGROUP). " 1266 (string 60)) 1267 (xerrwd msg 60 29 0 0 0 0 0 0.0d0 0.0d0) 1268 (f2cl-lib:f2cl-set-string msg 1269 " Length needed is >= LENRW (=I1), exceeds LRW (=I2)" 1270 (string 60)) 1271 (xerrwd msg 60 29 0 2 lenrw lrw 0 0.0d0 0.0d0) 1272 (go label700) 1273 label630 1274 (f2cl-lib:f2cl-set-string msg 1275 "DLSODES- RWORK length insufficient (for Subroutine ODRV). " 1276 (string 60)) 1277 (xerrwd msg 60 30 0 0 0 0 0 0.0d0 0.0d0) 1278 (f2cl-lib:f2cl-set-string msg 1279 " Length needed is >= LENRW (=I1), exceeds LRW (=I2)" 1280 (string 60)) 1281 (xerrwd msg 60 30 0 2 lenrw lrw 0 0.0d0 0.0d0) 1282 (go label700) 1283 label631 1284 (f2cl-lib:f2cl-set-string msg 1285 "DLSODES- Error from ODRV in Yale Sparse Matrix Package. " 1286 (string 60)) 1287 (xerrwd msg 60 31 0 0 0 0 0 0.0d0 0.0d0) 1288 (setf imul (the f2cl-lib:integer4 (truncate (- iys 1) n))) 1289 (setf irem (f2cl-lib:int-sub iys (f2cl-lib:int-mul imul n))) 1290 (f2cl-lib:f2cl-set-string msg 1291 " At T (=R1), ODRV returned error flag = I1*NEQ + I2. " 1292 (string 60)) 1293 (xerrwd msg 60 31 0 2 imul irem 1 tn 0.0d0) 1294 (go label700) 1295 label632 1296 (f2cl-lib:f2cl-set-string msg 1297 "DLSODES- RWORK length insufficient (for Subroutine CDRV). " 1298 (string 60)) 1299 (xerrwd msg 60 32 0 0 0 0 0 0.0d0 0.0d0) 1300 (f2cl-lib:f2cl-set-string msg 1301 " Length needed is >= LENRW (=I1), exceeds LRW (=I2)" 1302 (string 60)) 1303 (xerrwd msg 60 32 0 2 lenrw lrw 0 0.0d0 0.0d0) 1304 (go label700) 1305 label633 1306 (f2cl-lib:f2cl-set-string msg 1307 "DLSODES- Error from CDRV in Yale Sparse Matrix Package. " 1308 (string 60)) 1309 (xerrwd msg 60 33 0 0 0 0 0 0.0d0 0.0d0) 1310 (setf imul (the f2cl-lib:integer4 (truncate (- iys 1) n))) 1311 (setf irem (f2cl-lib:int-sub iys (f2cl-lib:int-mul imul n))) 1312 (f2cl-lib:f2cl-set-string msg 1313 " At T (=R1), CDRV returned error flag = I1*NEQ + I2. " 1314 (string 60)) 1315 (xerrwd msg 60 33 0 2 imul irem 1 tn 0.0d0) 1316 (cond 1317 ((= imul 2) 1318 (f2cl-lib:f2cl-set-string msg 1319 " Duplicate entry in sparsity structure descriptors. " 1320 (string 60)) 1321 (xerrwd msg 60 33 0 0 0 0 0 0.0d0 0.0d0))) 1322 (cond 1323 ((or (= imul 3) (= imul 6)) 1324 (f2cl-lib:f2cl-set-string msg 1325 " Insufficient storage for NSFC (called by CDRV). " 1326 (string 60)) 1327 (xerrwd msg 60 33 0 0 0 0 0 0.0d0 0.0d0))) 1328 label700 1329 (setf istate -3) 1330 (go end_label) 1331 label800 1332 (f2cl-lib:f2cl-set-string msg 1333 "DLSODES- Run aborted.. apparent infinite loop. " 1334 (string 60)) 1335 (xerrwd msg 50 303 2 0 0 0 0 0.0d0 0.0d0) 1336 (go end_label) 1337 end_label 1338 (return 1339 (values nil 1340 nil 1341 nil 1342 t$ 1343 nil 1344 nil 1345 nil 1346 nil 1347 nil 1348 istate 1349 nil 1350 nil 1351 nil 1352 nil 1353 nil 1354 nil 1355 nil)))))))) 1356 1357(in-package #-gcl #:cl-user #+gcl "CL-USER") 1358#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) 1359(eval-when (:load-toplevel :compile-toplevel :execute) 1360 (setf (gethash 'fortran-to-lisp::dlsodes 1361 fortran-to-lisp::*f2cl-function-info*) 1362 (fortran-to-lisp::make-f2cl-finfo 1363 :arg-types '(t (array fortran-to-lisp::integer4 (*)) 1364 (array double-float (*)) (double-float) (double-float) 1365 (fortran-to-lisp::integer4) (array double-float (*)) 1366 (array double-float (*)) (fortran-to-lisp::integer4) 1367 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4) 1368 (array double-float (*)) (fortran-to-lisp::integer4) 1369 (array fortran-to-lisp::integer4 (*)) 1370 (fortran-to-lisp::integer4) t 1371 (fortran-to-lisp::integer4)) 1372 :return-values '(nil nil nil fortran-to-lisp::t$ nil nil nil nil nil 1373 fortran-to-lisp::istate nil nil nil nil nil nil 1374 nil) 1375 :calls '(fortran-to-lisp::dstode fortran-to-lisp::xerrwd 1376 fortran-to-lisp::dintdy fortran-to-lisp::dvnorm 1377 fortran-to-lisp::diprep fortran-to-lisp::dewset)))) 1378 1379