share/odepack/src/dprepi.lisp

   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 dprepi (neq y s yh savr ewt rtem ia ja ic jc wk iwk ipper res jac adda)
  21   (declare (type (f2cl-lib:integer4) ipper)
  22            (type (array double-float (*)) wk rtem ewt savr yh s y)
  23            (type (array f2cl-lib:integer4 (*)) iwk jc ic 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                       (iesp (aref (dlss01-part-1 *dlss01-common-block*) 1))
  29                       (istatc (aref (dlss01-part-1 *dlss01-common-block*) 2))
  30                       (iys (aref (dlss01-part-1 *dlss01-common-block*) 3))
  31                       (iba (aref (dlss01-part-1 *dlss01-common-block*) 4))
  32                       (ibian (aref (dlss01-part-1 *dlss01-common-block*) 5))
  33                       (ibjan (aref (dlss01-part-1 *dlss01-common-block*) 6))
  34                       (ibjgp (aref (dlss01-part-1 *dlss01-common-block*) 7))
  35                       (ipian (aref (dlss01-part-1 *dlss01-common-block*) 8))
  36                       (ipjan (aref (dlss01-part-1 *dlss01-common-block*) 9))
  37                       (ipjgp (aref (dlss01-part-1 *dlss01-common-block*) 10))
  38                       (ipigp (aref (dlss01-part-1 *dlss01-common-block*) 11))
  39                       (ipr (aref (dlss01-part-1 *dlss01-common-block*) 12))
  40                       (ipc (aref (dlss01-part-1 *dlss01-common-block*) 13))
  41                       (ipic (aref (dlss01-part-1 *dlss01-common-block*) 14))
  42                       (ipisp (aref (dlss01-part-1 *dlss01-common-block*) 15))
  43                       (iprsp (aref (dlss01-part-1 *dlss01-common-block*) 16))
  44                       (ipa (aref (dlss01-part-1 *dlss01-common-block*) 17))
  45                       (lenwk (aref (dlss01-part-1 *dlss01-common-block*) 20))
  46                       (lreq (aref (dlss01-part-1 *dlss01-common-block*) 21))
  47                       (lrat (aref (dlss01-part-1 *dlss01-common-block*) 22))
  48                       (moss (aref (dlss01-part-1 *dlss01-common-block*) 25))
  49                       (ngp (aref (dlss01-part-1 *dlss01-common-block*) 28))
  50                       (nnz (aref (dlss01-part-1 *dlss01-common-block*) 30))
  51                       (nsp (aref (dlss01-part-1 *dlss01-common-block*) 31))
  52                       (nzl (aref (dlss01-part-1 *dlss01-common-block*) 32))
  53                       (nzu (aref (dlss01-part-1 *dlss01-common-block*) 33)))
  54       (f2cl-lib:with-multi-array-data
  55           ((neq f2cl-lib:integer4 neq-%data% neq-%offset%)
  56            (ia f2cl-lib:integer4 ia-%data% ia-%offset%)
  57            (ja f2cl-lib:integer4 ja-%data% ja-%offset%)
  58            (ic f2cl-lib:integer4 ic-%data% ic-%offset%)
  59            (jc f2cl-lib:integer4 jc-%data% jc-%offset%)
  60            (iwk f2cl-lib:integer4 iwk-%data% iwk-%offset%)
  61            (y double-float y-%data% y-%offset%)
  62            (s double-float s-%data% s-%offset%)
  63            (yh double-float yh-%data% yh-%offset%)
  64            (savr double-float savr-%data% savr-%offset%)
  65            (ewt double-float ewt-%data% ewt-%offset%)
  66            (rtem double-float rtem-%data% rtem-%offset%)
  67            (wk double-float wk-%data% wk-%offset%))
  68         (prog ((nzsut 0) (np1 0) (maxg 0) (ljfo 0) (liwk 0) (lenwk1 0)
  69                (lenigp 0) (ldif 0) (kcmin 0) (kcmax 0) (kamin 0) (kamax 0)
  70                (knew 0) (k 0) (j 0) (iptt2 0) (iptt1 0) (ipiu 0) (ipil 0)
  71                (ier 0) (ibr 0) (i 0) (yj 0.0d0) (fac 0.0d0) (erwt 0.0d0))
  72           (declare (type (double-float) erwt fac yj)
  73                    (type (f2cl-lib:integer4) i ibr ier ipil ipiu iptt1 iptt2 j
  74                                              k knew kamax kamin kcmax kcmin
  75                                              ldif lenigp lenwk1 liwk ljfo maxg
  76                                              np1 nzsut))
  77           (setf ibian (f2cl-lib:int-mul lrat 2))
  78           (setf ipian (f2cl-lib:int-add ibian 1))
  79           (setf np1 (f2cl-lib:int-add n 1))
  80           (setf ipjan (f2cl-lib:int-add ipian np1))
  81           (setf ibjan (f2cl-lib:int-sub ipjan 1))
  82           (setf lenwk1 (f2cl-lib:int-sub lenwk n))
  83           (setf liwk (f2cl-lib:int-mul lenwk lrat))
  84           (if (= moss 0) (setf liwk (f2cl-lib:int-sub liwk n)))
  85           (if (or (= moss 1) (= moss 2))
  86               (setf liwk (f2cl-lib:int-mul lenwk1 lrat)))
  87           (if (> (f2cl-lib:int-sub (f2cl-lib:int-add ipjan n) 1) liwk)
  88               (go label310))
  89           (if (= moss 0) (go label30))
  90           (if (= istatc 3) (go label20))
  91           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  92                         ((> i n) nil)
  93             (tagbody
  94               (setf erwt
  95                       (/ 1.0d0
  96                          (f2cl-lib:fref ewt-%data% (i) ((1 *)) ewt-%offset%)))
  97               (setf fac (+ 1.0d0 (/ 1.0d0 (+ i 1.0d0))))
  98               (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
  99                       (+ (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
 100                          (* fac
 101                             (f2cl-lib:sign erwt
 102                                            (f2cl-lib:fref y-%data%
 103                                                           (i)
 104                                                           ((1 *))
 105                                                           y-%offset%)))))
 106               (setf (f2cl-lib:fref s-%data% (i) ((1 *)) s-%offset%)
 107                       (+ 1.0d0 (* fac erwt)))
 108              label10))
 109           (f2cl-lib:computed-goto (label70 label100 label150 label200) moss)
 110          label20
 111           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 112                         ((> i n) nil)
 113             (tagbody
 114               (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
 115                       (f2cl-lib:fref yh-%data% (i) ((1 *)) yh-%offset%))
 116              label25
 117               (setf (f2cl-lib:fref s-%data% (i) ((1 *)) s-%offset%)
 118                       (f2cl-lib:fref yh-%data%
 119                                      ((f2cl-lib:int-add n i))
 120                                      ((1 *))
 121                                      yh-%offset%))))
 122           (f2cl-lib:computed-goto (label70 label100 label150 label200) moss)
 123          label30
 124           (setf knew ipjan)
 125           (setf kamin (f2cl-lib:fref ia-%data% (1) ((1 *)) ia-%offset%))
 126           (setf kcmin (f2cl-lib:fref ic-%data% (1) ((1 *)) ic-%offset%))
 127           (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 1)
 128           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 129                         ((> j n) nil)
 130             (tagbody
 131               (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 132                             ((> i n) nil)
 133                 (tagbody
 134                  label35
 135                   (setf (f2cl-lib:fref iwk-%data%
 136                                        ((f2cl-lib:int-add liwk i))
 137                                        ((1 *))
 138                                        iwk-%offset%)
 139                           0)))
 140               (setf kamax
 141                       (f2cl-lib:int-sub
 142                        (f2cl-lib:fref ia-%data%
 143                                       ((f2cl-lib:int-add j 1))
 144                                       ((1 *))
 145                                       ia-%offset%)
 146                        1))
 147               (if (> kamin kamax) (go label45))
 148               (f2cl-lib:fdo (k kamin (f2cl-lib:int-add k 1))
 149                             ((> k kamax) nil)
 150                 (tagbody
 151                   (setf i (f2cl-lib:fref ja-%data% (k) ((1 *)) ja-%offset%))
 152                   (setf (f2cl-lib:fref iwk-%data%
 153                                        ((f2cl-lib:int-add liwk i))
 154                                        ((1 *))
 155                                        iwk-%offset%)
 156                           1)
 157                   (if (> knew liwk) (go label310))
 158                   (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%)
 159                           i)
 160                   (setf knew (f2cl-lib:int-add knew 1))
 161                  label40))
 162              label45
 163               (setf kamin (f2cl-lib:int-add kamax 1))
 164               (setf kcmax
 165                       (f2cl-lib:int-sub
 166                        (f2cl-lib:fref ic-%data%
 167                                       ((f2cl-lib:int-add j 1))
 168                                       ((1 *))
 169                                       ic-%offset%)
 170                        1))
 171               (if (> kcmin kcmax) (go label55))
 172               (f2cl-lib:fdo (k kcmin (f2cl-lib:int-add k 1))
 173                             ((> k kcmax) nil)
 174                 (tagbody
 175                   (setf i (f2cl-lib:fref jc-%data% (k) ((1 *)) jc-%offset%))
 176                   (if
 177                    (/=
 178                     (f2cl-lib:fref iwk-%data%
 179                                    ((f2cl-lib:int-add liwk i))
 180                                    ((1 *))
 181                                    iwk-%offset%)
 182                     0)
 183                    (go label50))
 184                   (if (> knew liwk) (go label310))
 185                   (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%)
 186                           i)
 187                   (setf knew (f2cl-lib:int-add knew 1))
 188                  label50))
 189              label55
 190               (setf (f2cl-lib:fref iwk-%data%
 191                                    ((f2cl-lib:int-add ipian j))
 192                                    ((1 *))
 193                                    iwk-%offset%)
 194                       (f2cl-lib:int-sub (f2cl-lib:int-add knew 1) ipjan))
 195               (setf kcmin (f2cl-lib:int-add kcmax 1))
 196              label60))
 197           (go label240)
 198          label70
 199           (setf ier 1)
 200           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 201               (funcall res neq tn y s savr ier)
 202             (declare (ignore var-0 var-2 var-3 var-4))
 203             (when var-1
 204               (setf tn var-1))
 205             (when var-5
 206               (setf ier var-5)))
 207           (if (> ier 1) (go label370))
 208           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 209                         ((> i n) nil)
 210             (tagbody
 211               (setf (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 212                       0.0d0)
 213              label75
 214               (setf (f2cl-lib:fref wk-%data%
 215                                    ((f2cl-lib:int-add lenwk1 i))
 216                                    ((1 *))
 217                                    wk-%offset%)
 218                       0.0d0)))
 219           (setf k ipjan)
 220           (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 1)
 221           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 222                         ((> j n) nil)
 223             (tagbody
 224               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
 225                   (funcall adda
 226                            neq
 227                            tn
 228                            y
 229                            j
 230                            (f2cl-lib:array-slice iwk-%data%
 231                                                  f2cl-lib:integer4
 232                                                  (ipian)
 233                                                  ((1 *))
 234                                                  iwk-%offset%)
 235                            (f2cl-lib:array-slice iwk-%data%
 236                                                  f2cl-lib:integer4
 237                                                  (ipjan)
 238                                                  ((1 *))
 239                                                  iwk-%offset%)
 240                            (f2cl-lib:array-slice wk-%data%
 241                                                  double-float
 242                                                  ((+ lenwk1 1))
 243                                                  ((1 *))
 244                                                  wk-%offset%))
 245                 (declare (ignore var-0 var-2 var-4 var-5 var-6))
 246                 (when var-1
 247                   (setf tn var-1))
 248                 (when var-3
 249                   (setf j var-3)))
 250               (multiple-value-bind
 251                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
 252                   (funcall jac
 253                            neq
 254                            tn
 255                            y
 256                            s
 257                            j
 258                            (f2cl-lib:array-slice iwk-%data%
 259                                                  f2cl-lib:integer4
 260                                                  (ipian)
 261                                                  ((1 *))
 262                                                  iwk-%offset%)
 263                            (f2cl-lib:array-slice iwk-%data%
 264                                                  f2cl-lib:integer4
 265                                                  (ipjan)
 266                                                  ((1 *))
 267                                                  iwk-%offset%)
 268                            savr)
 269                 (declare (ignore var-0 var-2 var-3 var-5 var-6 var-7))
 270                 (when var-1
 271                   (setf tn var-1))
 272                 (when var-4
 273                   (setf j var-4)))
 274               (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 275                             ((> i n) nil)
 276                 (tagbody
 277                   (setf ljfo (f2cl-lib:int-add lenwk1 i))
 278                   (if
 279                    (= (f2cl-lib:fref wk-%data% (ljfo) ((1 *)) wk-%offset%)
 280                       0.0d0)
 281                    (go label80))
 282                   (setf (f2cl-lib:fref wk-%data% (ljfo) ((1 *)) wk-%offset%)
 283                           0.0d0)
 284                   (setf (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 285                           0.0d0)
 286                   (go label85)
 287                  label80
 288                   (if
 289                    (= (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 290                       0.0d0)
 291                    (go label90))
 292                   (setf (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 293                           0.0d0)
 294                  label85
 295                   (if (> k liwk) (go label310))
 296                   (setf (f2cl-lib:fref iwk-%data% (k) ((1 *)) iwk-%offset%) i)
 297                   (setf k (f2cl-lib:int-add k 1))
 298                  label90))
 299               (setf (f2cl-lib:fref iwk-%data%
 300                                    ((f2cl-lib:int-add ipian j))
 301                                    ((1 *))
 302                                    iwk-%offset%)
 303                       (f2cl-lib:int-sub (f2cl-lib:int-add k 1) ipjan))
 304              label95))
 305           (go label240)
 306          label100
 307           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 308                         ((> i n) nil)
 309             (tagbody
 310              label105
 311               (setf (f2cl-lib:fref wk-%data%
 312                                    ((f2cl-lib:int-add lenwk1 i))
 313                                    ((1 *))
 314                                    wk-%offset%)
 315                       0.0d0)))
 316           (setf k ipjan)
 317           (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 1)
 318           (setf ier -1)
 319           (if (= miter 1) (setf ier 1))
 320           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 321               (funcall res neq tn y s savr ier)
 322             (declare (ignore var-0 var-2 var-3 var-4))
 323             (when var-1
 324               (setf tn var-1))
 325             (when var-5
 326               (setf ier var-5)))
 327           (if (> ier 1) (go label370))
 328           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 329                         ((> j n) nil)
 330             (tagbody
 331               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
 332                   (funcall adda
 333                            neq
 334                            tn
 335                            y
 336                            j
 337                            (f2cl-lib:array-slice iwk-%data%
 338                                                  f2cl-lib:integer4
 339                                                  (ipian)
 340                                                  ((1 *))
 341                                                  iwk-%offset%)
 342                            (f2cl-lib:array-slice iwk-%data%
 343                                                  f2cl-lib:integer4
 344                                                  (ipjan)
 345                                                  ((1 *))
 346                                                  iwk-%offset%)
 347                            (f2cl-lib:array-slice wk-%data%
 348                                                  double-float
 349                                                  ((+ lenwk1 1))
 350                                                  ((1 *))
 351                                                  wk-%offset%))
 352                 (declare (ignore var-0 var-2 var-4 var-5 var-6))
 353                 (when var-1
 354                   (setf tn var-1))
 355                 (when var-3
 356                   (setf j var-3)))
 357               (setf yj (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%))
 358               (setf erwt
 359                       (/ 1.0d0
 360                          (f2cl-lib:fref ewt-%data% (j) ((1 *)) ewt-%offset%)))
 361               (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 362                       (+ yj (f2cl-lib:sign erwt yj)))
 363               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 364                   (funcall res neq tn y s rtem ier)
 365                 (declare (ignore var-0 var-2 var-3 var-4))
 366                 (when var-1
 367                   (setf tn var-1))
 368                 (when var-5
 369                   (setf ier var-5)))
 370               (if (> ier 1) (go end_label))
 371               (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%) yj)
 372               (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 373                             ((> i n) nil)
 374                 (tagbody
 375                   (setf ljfo (f2cl-lib:int-add lenwk1 i))
 376                   (if
 377                    (= (f2cl-lib:fref wk-%data% (ljfo) ((1 *)) wk-%offset%)
 378                       0.0d0)
 379                    (go label110))
 380                   (setf (f2cl-lib:fref wk-%data% (ljfo) ((1 *)) wk-%offset%)
 381                           0.0d0)
 382                   (go label115)
 383                  label110
 384                   (if
 385                    (= (f2cl-lib:fref rtem-%data% (i) ((1 *)) rtem-%offset%)
 386                       (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%))
 387                    (go label120))
 388                  label115
 389                   (if (> k liwk) (go label310))
 390                   (setf (f2cl-lib:fref iwk-%data% (k) ((1 *)) iwk-%offset%) i)
 391                   (setf k (f2cl-lib:int-add k 1))
 392                  label120))
 393               (setf (f2cl-lib:fref iwk-%data%
 394                                    ((f2cl-lib:int-add ipian j))
 395                                    ((1 *))
 396                                    iwk-%offset%)
 397                       (f2cl-lib:int-sub (f2cl-lib:int-add k 1) ipjan))
 398              label130))
 399           (go label240)
 400          label150
 401           (setf ier 1)
 402           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 403               (funcall res neq tn y s savr ier)
 404             (declare (ignore var-0 var-2 var-3 var-4))
 405             (when var-1
 406               (setf tn var-1))
 407             (when var-5
 408               (setf ier var-5)))
 409           (if (> ier 1) (go label370))
 410           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 411                         ((> i n) nil)
 412             (tagbody
 413              label155
 414               (setf (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 415                       0.0d0)))
 416           (setf knew ipjan)
 417           (setf kamin (f2cl-lib:fref ia-%data% (1) ((1 *)) ia-%offset%))
 418           (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 1)
 419           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 420                         ((> j n) nil)
 421             (tagbody
 422               (multiple-value-bind
 423                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
 424                   (funcall jac
 425                            neq
 426                            tn
 427                            y
 428                            s
 429                            j
 430                            (f2cl-lib:array-slice iwk-%data%
 431                                                  f2cl-lib:integer4
 432                                                  (ipian)
 433                                                  ((1 *))
 434                                                  iwk-%offset%)
 435                            (f2cl-lib:array-slice iwk-%data%
 436                                                  f2cl-lib:integer4
 437                                                  (ipjan)
 438                                                  ((1 *))
 439                                                  iwk-%offset%)
 440                            savr)
 441                 (declare (ignore var-0 var-2 var-3 var-5 var-6 var-7))
 442                 (when var-1
 443                   (setf tn var-1))
 444                 (when var-4
 445                   (setf j var-4)))
 446               (setf kamax
 447                       (f2cl-lib:int-sub
 448                        (f2cl-lib:fref ia-%data%
 449                                       ((f2cl-lib:int-add j 1))
 450                                       ((1 *))
 451                                       ia-%offset%)
 452                        1))
 453               (if (> kamin kamax) (go label170))
 454               (f2cl-lib:fdo (k kamin (f2cl-lib:int-add k 1))
 455                             ((> k kamax) nil)
 456                 (tagbody
 457                   (setf i (f2cl-lib:fref ja-%data% (k) ((1 *)) ja-%offset%))
 458                   (setf (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 459                           0.0d0)
 460                   (if (> knew liwk) (go label310))
 461                   (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%)
 462                           i)
 463                   (setf knew (f2cl-lib:int-add knew 1))
 464                  label160))
 465              label170
 466               (setf kamin (f2cl-lib:int-add kamax 1))
 467               (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 468                             ((> i n) nil)
 469                 (tagbody
 470                   (if
 471                    (= (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 472                       0.0d0)
 473                    (go label180))
 474                   (setf (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%)
 475                           0.0d0)
 476                   (if (> knew liwk) (go label310))
 477                   (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%)
 478                           i)
 479                   (setf knew (f2cl-lib:int-add knew 1))
 480                  label180))
 481               (setf (f2cl-lib:fref iwk-%data%
 482                                    ((f2cl-lib:int-add ipian j))
 483                                    ((1 *))
 484                                    iwk-%offset%)
 485                       (f2cl-lib:int-sub (f2cl-lib:int-add knew 1) ipjan))
 486              label190))
 487           (go label240)
 488          label200
 489           (setf knew ipjan)
 490           (setf kamin (f2cl-lib:fref ia-%data% (1) ((1 *)) ia-%offset%))
 491           (setf (f2cl-lib:fref iwk-%data% (ipian) ((1 *)) iwk-%offset%) 1)
 492           (setf ier -1)
 493           (if (= miter 1) (setf ier 1))
 494           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 495               (funcall res neq tn y s savr ier)
 496             (declare (ignore var-0 var-2 var-3 var-4))
 497             (when var-1
 498               (setf tn var-1))
 499             (when var-5
 500               (setf ier var-5)))
 501           (if (> ier 1) (go label370))
 502           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 503                         ((> j n) nil)
 504             (tagbody
 505               (setf yj (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%))
 506               (setf erwt
 507                       (/ 1.0d0
 508                          (f2cl-lib:fref ewt-%data% (j) ((1 *)) ewt-%offset%)))
 509               (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 510                       (+ yj (f2cl-lib:sign erwt yj)))
 511               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 512                   (funcall res neq tn y s rtem ier)
 513                 (declare (ignore var-0 var-2 var-3 var-4))
 514                 (when var-1
 515                   (setf tn var-1))
 516                 (when var-5
 517                   (setf ier var-5)))
 518               (if (> ier 1) (go end_label))
 519               (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%) yj)
 520               (setf kamax
 521                       (f2cl-lib:int-sub
 522                        (f2cl-lib:fref ia-%data%
 523                                       ((f2cl-lib:int-add j 1))
 524                                       ((1 *))
 525                                       ia-%offset%)
 526                        1))
 527               (if (> kamin kamax) (go label225))
 528               (f2cl-lib:fdo (k kamin (f2cl-lib:int-add k 1))
 529                             ((> k kamax) nil)
 530                 (tagbody
 531                   (setf i (f2cl-lib:fref ja-%data% (k) ((1 *)) ja-%offset%))
 532                   (setf (f2cl-lib:fref rtem-%data% (i) ((1 *)) rtem-%offset%)
 533                           (f2cl-lib:fref savr-%data%
 534                                          (i)
 535                                          ((1 *))
 536                                          savr-%offset%))
 537                   (if (> knew liwk) (go label310))
 538                   (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%)
 539                           i)
 540                   (setf knew (f2cl-lib:int-add knew 1))
 541                  label220))
 542              label225
 543               (setf kamin (f2cl-lib:int-add kamax 1))
 544               (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 545                             ((> i n) nil)
 546                 (tagbody
 547                   (if
 548                    (= (f2cl-lib:fref rtem-%data% (i) ((1 *)) rtem-%offset%)
 549                       (f2cl-lib:fref savr-%data% (i) ((1 *)) savr-%offset%))
 550                    (go label230))
 551                   (if (> knew liwk) (go label310))
 552                   (setf (f2cl-lib:fref iwk-%data% (knew) ((1 *)) iwk-%offset%)
 553                           i)
 554                   (setf knew (f2cl-lib:int-add knew 1))
 555                  label230))
 556               (setf (f2cl-lib:fref iwk-%data%
 557                                    ((f2cl-lib:int-add ipian j))
 558                                    ((1 *))
 559                                    iwk-%offset%)
 560                       (f2cl-lib:int-sub (f2cl-lib:int-add knew 1) ipjan))
 561              label235))
 562          label240
 563           (if (or (= moss 0) (= istatc 3)) (go label250))
 564           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 565                         ((> i n) nil)
 566             (tagbody
 567              label245
 568               (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
 569                       (f2cl-lib:fref yh-%data% (i) ((1 *)) yh-%offset%))))
 570          label250
 571           (setf nnz
 572                   (f2cl-lib:int-sub
 573                    (f2cl-lib:fref iwk-%data%
 574                                   ((f2cl-lib:int-add ipian n))
 575                                   ((1 *))
 576                                   iwk-%offset%)
 577                    1))
 578           (setf ipper 0)
 579           (setf ngp 0)
 580           (setf lenigp 0)
 581           (setf ipigp (f2cl-lib:int-add ipjan nnz))
 582           (if (/= miter 2) (go label260))
 583           (setf maxg np1)
 584           (setf ipjgp (f2cl-lib:int-add ipjan nnz))
 585           (setf ibjgp (f2cl-lib:int-sub ipjgp 1))
 586           (setf ipigp (f2cl-lib:int-add ipjgp n))
 587           (setf iptt1 (f2cl-lib:int-add ipigp np1))
 588           (setf iptt2 (f2cl-lib:int-add iptt1 n))
 589           (setf lreq (f2cl-lib:int-sub (f2cl-lib:int-add iptt2 n) 1))
 590           (if (> lreq liwk) (go label320))
 591           (multiple-value-bind
 592                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
 593               (jgroup n
 594                (f2cl-lib:array-slice iwk-%data%
 595                                      f2cl-lib:integer4
 596                                      (ipian)
 597                                      ((1 *))
 598                                      iwk-%offset%)
 599                (f2cl-lib:array-slice iwk-%data%
 600                                      f2cl-lib:integer4
 601                                      (ipjan)
 602                                      ((1 *))
 603                                      iwk-%offset%)
 604                maxg ngp
 605                (f2cl-lib:array-slice iwk-%data%
 606                                      f2cl-lib:integer4
 607                                      (ipigp)
 608                                      ((1 *))
 609                                      iwk-%offset%)
 610                (f2cl-lib:array-slice iwk-%data%
 611                                      f2cl-lib:integer4
 612                                      (ipjgp)
 613                                      ((1 *))
 614                                      iwk-%offset%)
 615                (f2cl-lib:array-slice iwk-%data%
 616                                      f2cl-lib:integer4
 617                                      (iptt1)
 618                                      ((1 *))
 619                                      iwk-%offset%)
 620                (f2cl-lib:array-slice iwk-%data%
 621                                      f2cl-lib:integer4
 622                                      (iptt2)
 623                                      ((1 *))
 624                                      iwk-%offset%)
 625                ier)
 626             (declare (ignore var-0 var-1 var-2 var-3 var-5 var-6 var-7 var-8))
 627             (setf ngp var-4)
 628             (setf ier var-9))
 629           (if (/= ier 0) (go label320))
 630           (setf lenigp (f2cl-lib:int-add ngp 1))
 631          label260
 632           (setf ipr (f2cl-lib:int-add ipigp lenigp))
 633           (setf ipc ipr)
 634           (setf ipic (f2cl-lib:int-add ipc n))
 635           (setf ipisp (f2cl-lib:int-add ipic n))
 636           (setf iprsp
 637                   (+ (the f2cl-lib:integer4 (truncate (- ipisp 2) lrat)) 2))
 638           (setf iesp (f2cl-lib:int-sub (f2cl-lib:int-add lenwk 1) iprsp))
 639           (if (< iesp 0) (go label330))
 640           (setf ibr (f2cl-lib:int-sub ipr 1))
 641           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 642                         ((> i n) nil)
 643             (tagbody
 644              label270
 645               (setf (f2cl-lib:fref iwk-%data%
 646                                    ((f2cl-lib:int-add ibr i))
 647                                    ((1 *))
 648                                    iwk-%offset%)
 649                       i)))
 650           (setf nsp (f2cl-lib:int-sub (f2cl-lib:int-add liwk 1) ipisp))
 651           (multiple-value-bind
 652                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
 653               (odrv n
 654                (f2cl-lib:array-slice iwk-%data%
 655                                      f2cl-lib:integer4
 656                                      (ipian)
 657                                      ((1 *))
 658                                      iwk-%offset%)
 659                (f2cl-lib:array-slice iwk-%data%
 660                                      f2cl-lib:integer4
 661                                      (ipjan)
 662                                      ((1 *))
 663                                      iwk-%offset%)
 664                wk
 665                (f2cl-lib:array-slice iwk-%data%
 666                                      f2cl-lib:integer4
 667                                      (ipr)
 668                                      ((1 *))
 669                                      iwk-%offset%)
 670                (f2cl-lib:array-slice iwk-%data%
 671                                      f2cl-lib:integer4
 672                                      (ipic)
 673                                      ((1 *))
 674                                      iwk-%offset%)
 675                nsp
 676                (f2cl-lib:array-slice iwk-%data%
 677                                      f2cl-lib:integer4
 678                                      (ipisp)
 679                                      ((1 *))
 680                                      iwk-%offset%)
 681                1 iys)
 682             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
 683                              var-8))
 684             (setf iys var-9))
 685           (if (= iys (f2cl-lib:int-add (f2cl-lib:int-mul 11 n) 1))
 686               (go label340))
 687           (if (/= iys 0) (go label330))
 688           (setf ipa (f2cl-lib:int-sub (f2cl-lib:int-add lenwk 1) nnz))
 689           (setf nsp (f2cl-lib:int-sub ipa iprsp))
 690           (setf lreq
 691                   (+
 692                    (max (the f2cl-lib:integer4 (truncate (* 12 n) lrat))
 693                         (+ (the f2cl-lib:integer4 (truncate (* 6 n) lrat))
 694                            (f2cl-lib:int-mul 2 n)
 695                            nnz))
 696                    3))
 697           (setf lreq
 698                   (f2cl-lib:int-add
 699                    (f2cl-lib:int-sub (f2cl-lib:int-add lreq iprsp) 1)
 700                    nnz))
 701           (if (> lreq lenwk) (go label350))
 702           (setf iba (f2cl-lib:int-sub ipa 1))
 703           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 704                         ((> i nnz) nil)
 705             (tagbody
 706              label280
 707               (setf (f2cl-lib:fref wk-%data%
 708                                    ((f2cl-lib:int-add iba i))
 709                                    ((1 *))
 710                                    wk-%offset%)
 711                       0.0d0)))
 712           (setf ipisp
 713                   (f2cl-lib:int-add
 714                    (f2cl-lib:int-mul lrat (f2cl-lib:int-sub iprsp 1))
 715                    1))
 716           (multiple-value-bind
 717                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9
 718                  var-10 var-11 var-12 var-13 var-14)
 719               (cdrv n
 720                (f2cl-lib:array-slice iwk-%data%
 721                                      f2cl-lib:integer4
 722                                      (ipr)
 723                                      ((1 *))
 724                                      iwk-%offset%)
 725                (f2cl-lib:array-slice iwk-%data%
 726                                      f2cl-lib:integer4
 727                                      (ipc)
 728                                      ((1 *))
 729                                      iwk-%offset%)
 730                (f2cl-lib:array-slice iwk-%data%
 731                                      f2cl-lib:integer4
 732                                      (ipic)
 733                                      ((1 *))
 734                                      iwk-%offset%)
 735                (f2cl-lib:array-slice iwk-%data%
 736                                      f2cl-lib:integer4
 737                                      (ipian)
 738                                      ((1 *))
 739                                      iwk-%offset%)
 740                (f2cl-lib:array-slice iwk-%data%
 741                                      f2cl-lib:integer4
 742                                      (ipjan)
 743                                      ((1 *))
 744                                      iwk-%offset%)
 745                (f2cl-lib:array-slice wk-%data%
 746                                      double-float
 747                                      (ipa)
 748                                      ((1 *))
 749                                      wk-%offset%)
 750                (f2cl-lib:array-slice wk-%data%
 751                                      double-float
 752                                      (ipa)
 753                                      ((1 *))
 754                                      wk-%offset%)
 755                (f2cl-lib:array-slice wk-%data%
 756                                      double-float
 757                                      (ipa)
 758                                      ((1 *))
 759                                      wk-%offset%)
 760                nsp
 761                (f2cl-lib:array-slice iwk-%data%
 762                                      f2cl-lib:integer4
 763                                      (ipisp)
 764                                      ((1 *))
 765                                      iwk-%offset%)
 766                (f2cl-lib:array-slice wk-%data%
 767                                      double-float
 768                                      (iprsp)
 769                                      ((1 *))
 770                                      wk-%offset%)
 771                iesp 5 iys)
 772             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
 773                              var-8 var-9 var-10 var-11 var-13))
 774             (setf iesp var-12)
 775             (setf iys var-14))
 776           (setf lreq (f2cl-lib:int-sub lenwk iesp))
 777           (if (= iys (f2cl-lib:int-add (f2cl-lib:int-mul 10 n) 1))
 778               (go label350))
 779           (if (/= iys 0) (go label360))
 780           (setf ipil ipisp)
 781           (setf ipiu (f2cl-lib:int-add ipil (f2cl-lib:int-mul 2 n) 1))
 782           (setf nzu
 783                   (f2cl-lib:int-sub
 784                    (f2cl-lib:fref iwk-%data%
 785                                   ((f2cl-lib:int-add ipil n))
 786                                   ((1 *))
 787                                   iwk-%offset%)
 788                    (f2cl-lib:fref iwk-%data% (ipil) ((1 *)) iwk-%offset%)))
 789           (setf nzl
 790                   (f2cl-lib:int-sub
 791                    (f2cl-lib:fref iwk-%data%
 792                                   ((f2cl-lib:int-add ipiu n))
 793                                   ((1 *))
 794                                   iwk-%offset%)
 795                    (f2cl-lib:fref iwk-%data% (ipiu) ((1 *)) iwk-%offset%)))
 796           (if (> lrat 1) (go label290))
 797           (multiple-value-bind (var-0 var-1 var-2)
 798               (adjlr n
 799                (f2cl-lib:array-slice iwk-%data%
 800                                      f2cl-lib:integer4
 801                                      (ipisp)
 802                                      ((1 *))
 803                                      iwk-%offset%)
 804                ldif)
 805             (declare (ignore var-0 var-1))
 806             (setf ldif var-2))
 807           (setf lreq (f2cl-lib:int-add lreq ldif))
 808          label290
 809           (if (and (= lrat 2) (= nnz n)) (setf lreq (f2cl-lib:int-add lreq 1)))
 810           (setf nsp (f2cl-lib:int-sub (f2cl-lib:int-add nsp lreq) lenwk))
 811           (setf ipa (f2cl-lib:int-sub (f2cl-lib:int-add lreq 1) nnz))
 812           (setf iba (f2cl-lib:int-sub ipa 1))
 813           (setf ipper 0)
 814           (go end_label)
 815          label310
 816           (setf ipper -1)
 817           (setf lreq
 818                   (+ 2 (the f2cl-lib:integer4 (truncate (+ (* 2 n) 1) lrat))))
 819           (setf lreq
 820                   (max (the f2cl-lib:integer4 (f2cl-lib:int-add lenwk 1))
 821                        (the f2cl-lib:integer4 lreq)))
 822           (go end_label)
 823          label320
 824           (setf ipper -2)
 825           (setf lreq (+ (the f2cl-lib:integer4 (truncate (- lreq 1) lrat)) 1))
 826           (go end_label)
 827          label330
 828           (setf ipper -3)
 829           (multiple-value-bind (var-0 var-1 var-2 var-3)
 830               (cntnzu n
 831                (f2cl-lib:array-slice iwk-%data%
 832                                      f2cl-lib:integer4
 833                                      (ipian)
 834                                      ((1 *))
 835                                      iwk-%offset%)
 836                (f2cl-lib:array-slice iwk-%data%
 837                                      f2cl-lib:integer4
 838                                      (ipjan)
 839                                      ((1 *))
 840                                      iwk-%offset%)
 841                nzsut)
 842             (declare (ignore var-0 var-1 var-2))
 843             (setf nzsut var-3))
 844           (setf lreq
 845                   (+ (f2cl-lib:int-sub lenwk iesp)
 846                      (the f2cl-lib:integer4
 847                           (truncate (- (+ (* 3 n) (* 4 nzsut)) 1) lrat))
 848                      1))
 849           (go end_label)
 850          label340
 851           (setf ipper -4)
 852           (go end_label)
 853          label350
 854           (setf ipper -5)
 855           (go end_label)
 856          label360
 857           (setf ipper -6)
 858           (setf lreq lenwk)
 859           (go end_label)
 860          label370
 861           (setf ipper (f2cl-lib:int-sub -5 ier))
 862           (setf lreq
 863                   (+ 2 (the f2cl-lib:integer4 (truncate (+ (* 2 n) 1) lrat))))
 864           (go end_label)
 865          end_label
 866           (return
 867            (values nil
 868                    nil
 869                    nil
 870                    nil
 871                    nil
 872                    nil
 873                    nil
 874                    nil
 875                    nil
 876                    nil
 877                    nil
 878                    nil
 879                    nil
 880                    ipper
 881                    nil
 882                    nil
 883                    nil)))))))
 884
 885 (in-package #:cl-user)
 886 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 887 (eval-when (:load-toplevel :compile-toplevel :execute)
 888   (setf (gethash 'fortran-to-lisp::dprepi
 889                  fortran-to-lisp::*f2cl-function-info*)
 890           (fortran-to-lisp::make-f2cl-finfo
 891            :arg-types '((array fortran-to-lisp::integer4 (*))
 892                         (array double-float (*)) (array double-float (*))
 893                         (array double-float (*)) (array double-float (*))
 894                         (array double-float (*)) (array double-float (*))
 895                         (array fortran-to-lisp::integer4 (*))
 896                         (array fortran-to-lisp::integer4 (*))
 897                         (array fortran-to-lisp::integer4 (*))
 898                         (array fortran-to-lisp::integer4 (*))
 899                         (array double-float (*))
 900                         (array fortran-to-lisp::integer4 (*))
 901                         (fortran-to-lisp::integer4) t t t)
 902            :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
 903                             fortran-to-lisp::ipper nil nil nil)
 904            :calls '(fortran-to-lisp::cntnzu fortran-to-lisp::adjlr
 905                     fortran-to-lisp::cdrv fortran-to-lisp::odrv
 906                     fortran-to-lisp::jgroup))))
 907