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