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