share/odepack/src/mdp.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 mdp (k ek tail v l head last$ next mark)
  21   (declare (type (array f2cl-lib:integer4 (*)) mark next last$ head l v)
  22            (type (f2cl-lib:integer4) tail ek k))
  23   (f2cl-lib:with-multi-array-data
  24       ((v f2cl-lib:integer4 v-%data% v-%offset%)
  25        (l f2cl-lib:integer4 l-%data% l-%offset%)
  26        (head f2cl-lib:integer4 head-%data% head-%offset%)
  27        (last$ f2cl-lib:integer4 last$-%data% last$-%offset%)
  28        (next f2cl-lib:integer4 next-%data% next-%offset%)
  29        (mark f2cl-lib:integer4 mark-%data% mark-%offset%))
  30     (prog ((tag 0) (free 0) (li 0) (vi 0) (lvi 0) (evi 0) (s 0) (ls 0) (es 0)
  31            (ilp 0) (ilpmax 0) (i 0))
  32       (declare (type (f2cl-lib:integer4) i ilpmax ilp es ls s evi lvi vi li
  33                                          free tag))
  34       (setf tag (f2cl-lib:fref mark-%data% (ek) ((1 *)) mark-%offset%))
  35       (setf li ek)
  36       (setf ilpmax (f2cl-lib:fref last$-%data% (ek) ((1 *)) last$-%offset%))
  37       (if (<= ilpmax 0) (go label12))
  38       (f2cl-lib:fdo (ilp 1 (f2cl-lib:int-add ilp 1))
  39                     ((> ilp ilpmax) nil)
  40         (tagbody
  41           (setf i li)
  42           (setf li (f2cl-lib:fref l-%data% (i) ((1 *)) l-%offset%))
  43           (setf vi (f2cl-lib:fref v-%data% (li) ((1 *)) v-%offset%))
  44           (if (= (f2cl-lib:fref last$-%data% (vi) ((1 *)) last$-%offset%) 0)
  45               (go label3))
  46           (if (> (f2cl-lib:fref last$-%data% (vi) ((1 *)) last$-%offset%) 0)
  47               (go label1))
  48           (setf (f2cl-lib:fref head-%data%
  49                                ((f2cl-lib:int-sub
  50                                  (f2cl-lib:fref last$ (vi) ((1 *)))))
  51                                ((1 *))
  52                                head-%offset%)
  53                   (f2cl-lib:fref next-%data% (vi) ((1 *)) next-%offset%))
  54           (go label2)
  55          label1
  56           (setf (f2cl-lib:fref next-%data%
  57                                ((f2cl-lib:fref last$ (vi) ((1 *))))
  58                                ((1 *))
  59                                next-%offset%)
  60                   (f2cl-lib:fref next-%data% (vi) ((1 *)) next-%offset%))
  61          label2
  62           (if (> (f2cl-lib:fref next-%data% (vi) ((1 *)) next-%offset%) 0)
  63               (setf (f2cl-lib:fref last$-%data%
  64                                    ((f2cl-lib:fref next (vi) ((1 *))))
  65                                    ((1 *))
  66                                    last$-%offset%)
  67                       (f2cl-lib:fref last$-%data%
  68                                      (vi)
  69                                      ((1 *))
  70                                      last$-%offset%)))
  71          label3
  72           (setf ls vi)
  73          label4
  74           (setf s ls)
  75           (setf ls (f2cl-lib:fref l-%data% (s) ((1 *)) l-%offset%))
  76           (if (= ls 0) (go label6))
  77           (setf es (f2cl-lib:fref v-%data% (ls) ((1 *)) v-%offset%))
  78           (if (< (f2cl-lib:fref mark-%data% (es) ((1 *)) mark-%offset%) tag)
  79               (go label5))
  80           (setf free ls)
  81           (setf (f2cl-lib:fref l-%data% (s) ((1 *)) l-%offset%)
  82                   (f2cl-lib:fref l-%data% (ls) ((1 *)) l-%offset%))
  83           (setf ls s)
  84          label5
  85           (go label4)
  86          label6
  87           (setf lvi (f2cl-lib:fref l-%data% (vi) ((1 *)) l-%offset%))
  88           (if (/= lvi 0) (go label7))
  89           (setf (f2cl-lib:fref l-%data% (i) ((1 *)) l-%offset%)
  90                   (f2cl-lib:fref l-%data% (li) ((1 *)) l-%offset%))
  91           (setf li i)
  92           (setf k (f2cl-lib:int-add k 1))
  93           (setf (f2cl-lib:fref next-%data% (vi) ((1 *)) next-%offset%)
  94                   (f2cl-lib:int-sub k))
  95           (setf (f2cl-lib:fref last$-%data% (ek) ((1 *)) last$-%offset%)
  96                   (f2cl-lib:int-sub
  97                    (f2cl-lib:fref last$-%data% (ek) ((1 *)) last$-%offset%)
  98                    1))
  99           (go label11)
 100          label7
 101           (if (/= (f2cl-lib:fref l-%data% (lvi) ((1 *)) l-%offset%) 0)
 102               (go label9))
 103           (setf evi (f2cl-lib:fref v-%data% (lvi) ((1 *)) v-%offset%))
 104           (if (>= (f2cl-lib:fref next-%data% (evi) ((1 *)) next-%offset%) 0)
 105               (go label9))
 106           (if (< (f2cl-lib:fref mark-%data% (evi) ((1 *)) mark-%offset%) 0)
 107               (go label8))
 108           (setf (f2cl-lib:fref last$-%data% (vi) ((1 *)) last$-%offset%) evi)
 109           (setf (f2cl-lib:fref mark-%data% (evi) ((1 *)) mark-%offset%) -1)
 110           (setf (f2cl-lib:fref l-%data% (tail) ((1 *)) l-%offset%) li)
 111           (setf tail li)
 112           (setf (f2cl-lib:fref l-%data% (i) ((1 *)) l-%offset%)
 113                   (f2cl-lib:fref l-%data% (li) ((1 *)) l-%offset%))
 114           (setf li i)
 115           (go label10)
 116          label8
 117           (setf (f2cl-lib:fref last$-%data% (vi) ((1 *)) last$-%offset%) 0)
 118           (setf (f2cl-lib:fref mark-%data% (evi) ((1 *)) mark-%offset%)
 119                   (f2cl-lib:int-sub
 120                    (f2cl-lib:fref mark-%data% (evi) ((1 *)) mark-%offset%)
 121                    1))
 122           (go label10)
 123          label9
 124           (setf (f2cl-lib:fref last$-%data% (vi) ((1 *)) last$-%offset%)
 125                   (f2cl-lib:int-sub ek))
 126          label10
 127           (setf (f2cl-lib:fref v-%data% (free) ((1 *)) v-%offset%) ek)
 128           (setf (f2cl-lib:fref l-%data% (free) ((1 *)) l-%offset%)
 129                   (f2cl-lib:fref l-%data% (vi) ((1 *)) l-%offset%))
 130           (setf (f2cl-lib:fref l-%data% (vi) ((1 *)) l-%offset%) free)
 131          label11))
 132      label12
 133       (setf (f2cl-lib:fref l-%data% (tail) ((1 *)) l-%offset%) 0)
 134       (go end_label)
 135      end_label
 136       (return (values k nil tail nil nil nil nil nil nil)))))
 137
 138 (in-package #:cl-user)
 139 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 140 (eval-when (:load-toplevel :compile-toplevel :execute)
 141   (setf (gethash 'fortran-to-lisp::mdp fortran-to-lisp::*f2cl-function-info*)
 142           (fortran-to-lisp::make-f2cl-finfo
 143            :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 144                         (fortran-to-lisp::integer4)
 145                         (array fortran-to-lisp::integer4 (*))
 146                         (array fortran-to-lisp::integer4 (*))
 147                         (array fortran-to-lisp::integer4 (*))
 148                         (array fortran-to-lisp::integer4 (*))
 149                         (array fortran-to-lisp::integer4 (*))
 150                         (array fortran-to-lisp::integer4 (*)))
 151            :return-values '(fortran-to-lisp::k nil fortran-to-lisp::tail nil
 152                             nil nil nil nil nil)
 153            :calls 'nil)))
 154