share/odepack/src/dsrcar.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 (let ((lenrls 218) (lenils 37) (lenrla 22) (lenila 9) (lenrlr 5) (lenilr 9))
  21   (declare (type (f2cl-lib:integer4) lenrls lenils lenrla lenila lenrlr
  22                                      lenilr))
  23   (defun dsrcar (rsav isav job)
  24     (declare (type (f2cl-lib:integer4) job)
  25              (type (array f2cl-lib:integer4 (*)) isav)
  26              (type (array double-float (*)) rsav))
  27     (let ((dls001-rls
  28            (make-array 218
  29                        :element-type 'double-float
  30                        :displaced-to (dls001-part-0 *dls001-common-block*)
  31                        :displaced-index-offset 0))
  32           (dls001-ils
  33            (make-array 37
  34                        :element-type 'f2cl-lib:integer4
  35                        :displaced-to (dls001-part-1 *dls001-common-block*)
  36                        :displaced-index-offset 0))
  37           (dlsa01-rlsa
  38            (make-array 22
  39                        :element-type 'double-float
  40                        :displaced-to (dlsa01-part-0 *dlsa01-common-block*)
  41                        :displaced-index-offset 0))
  42           (dlsa01-ilsa
  43            (make-array 9
  44                        :element-type 'f2cl-lib:integer4
  45                        :displaced-to (dlsa01-part-1 *dlsa01-common-block*)
  46                        :displaced-index-offset 0))
  47           (dlsr01-rlsr
  48            (make-array 5
  49                        :element-type 'double-float
  50                        :displaced-to (dlsr01-part-0 *dlsr01-common-block*)
  51                        :displaced-index-offset 0))
  52           (dlsr01-ilsr
  53            (make-array 9
  54                        :element-type 'f2cl-lib:integer4
  55                        :displaced-to (dlsr01-part-1 *dlsr01-common-block*)
  56                        :displaced-index-offset 0)))
  57       (symbol-macrolet ((rls dls001-rls)
  58                         (ils dls001-ils)
  59                         (rlsa dlsa01-rlsa)
  60                         (ilsa dlsa01-ilsa)
  61                         (rlsr dlsr01-rlsr)
  62                         (ilsr dlsr01-ilsr))
  63         (f2cl-lib:with-multi-array-data
  64             ((rsav double-float rsav-%data% rsav-%offset%)
  65              (isav f2cl-lib:integer4 isav-%data% isav-%offset%))
  66           (prog ((ioff 0) (i 0))
  67             (declare (type (f2cl-lib:integer4) i ioff))
  68             (if (= job 2) (go label100))
  69             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  70                           ((> i lenrls) nil)
  71               (tagbody
  72                label10
  73                 (setf (f2cl-lib:fref rsav-%data% (i) ((1 *)) rsav-%offset%)
  74                         (f2cl-lib:fref rls (i) ((1 218))))))
  75             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  76                           ((> i lenrla) nil)
  77               (tagbody
  78                label15
  79                 (setf (f2cl-lib:fref rsav-%data%
  80                                      ((f2cl-lib:int-add lenrls i))
  81                                      ((1 *))
  82                                      rsav-%offset%)
  83                         (f2cl-lib:fref rlsa (i) ((1 22))))))
  84             (setf ioff (f2cl-lib:int-add lenrls lenrla))
  85             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  86                           ((> i lenrlr) nil)
  87               (tagbody
  88                label20
  89                 (setf (f2cl-lib:fref rsav-%data%
  90                                      ((f2cl-lib:int-add ioff i))
  91                                      ((1 *))
  92                                      rsav-%offset%)
  93                         (f2cl-lib:fref rlsr (i) ((1 5))))))
  94             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  95                           ((> i lenils) nil)
  96               (tagbody
  97                label30
  98                 (setf (f2cl-lib:fref isav-%data% (i) ((1 *)) isav-%offset%)
  99                         (f2cl-lib:fref ils (i) ((1 37))))))
 100             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 101                           ((> i lenila) nil)
 102               (tagbody
 103                label35
 104                 (setf (f2cl-lib:fref isav-%data%
 105                                      ((f2cl-lib:int-add lenils i))
 106                                      ((1 *))
 107                                      isav-%offset%)
 108                         (f2cl-lib:fref ilsa (i) ((1 9))))))
 109             (setf ioff (f2cl-lib:int-add lenils lenila))
 110             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 111                           ((> i lenilr) nil)
 112               (tagbody
 113                label40
 114                 (setf (f2cl-lib:fref isav-%data%
 115                                      ((f2cl-lib:int-add ioff i))
 116                                      ((1 *))
 117                                      isav-%offset%)
 118                         (f2cl-lib:fref ilsr (i) ((1 9))))))
 119             (go end_label)
 120            label100
 121             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 122                           ((> i lenrls) nil)
 123               (tagbody
 124                label110
 125                 (setf (f2cl-lib:fref rls (i) ((1 218)))
 126                         (f2cl-lib:fref rsav-%data%
 127                                        (i)
 128                                        ((1 *))
 129                                        rsav-%offset%))))
 130             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 131                           ((> i lenrla) nil)
 132               (tagbody
 133                label115
 134                 (setf (f2cl-lib:fref rlsa (i) ((1 22)))
 135                         (f2cl-lib:fref rsav-%data%
 136                                        ((f2cl-lib:int-add lenrls i))
 137                                        ((1 *))
 138                                        rsav-%offset%))))
 139             (setf ioff (f2cl-lib:int-add lenrls lenrla))
 140             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 141                           ((> i lenrlr) nil)
 142               (tagbody
 143                label120
 144                 (setf (f2cl-lib:fref rlsr (i) ((1 5)))
 145                         (f2cl-lib:fref rsav-%data%
 146                                        ((f2cl-lib:int-add ioff i))
 147                                        ((1 *))
 148                                        rsav-%offset%))))
 149             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 150                           ((> i lenils) nil)
 151               (tagbody
 152                label130
 153                 (setf (f2cl-lib:fref ils (i) ((1 37)))
 154                         (f2cl-lib:fref isav-%data%
 155                                        (i)
 156                                        ((1 *))
 157                                        isav-%offset%))))
 158             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 159                           ((> i lenila) nil)
 160               (tagbody
 161                label135
 162                 (setf (f2cl-lib:fref ilsa (i) ((1 9)))
 163                         (f2cl-lib:fref isav-%data%
 164                                        ((f2cl-lib:int-add lenils i))
 165                                        ((1 *))
 166                                        isav-%offset%))))
 167             (setf ioff (f2cl-lib:int-add lenils lenila))
 168             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 169                           ((> i lenilr) nil)
 170               (tagbody
 171                label140
 172                 (setf (f2cl-lib:fref ilsr (i) ((1 9)))
 173                         (f2cl-lib:fref isav-%data%
 174                                        ((f2cl-lib:int-add ioff i))
 175                                        ((1 *))
 176                                        isav-%offset%))))
 177             (go end_label)
 178            end_label
 179             (return (values nil nil nil))))))))
 180
 181 (in-package #:cl-user)
 182 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 183 (eval-when (:load-toplevel :compile-toplevel :execute)
 184   (setf (gethash 'fortran-to-lisp::dsrcar
 185                  fortran-to-lisp::*f2cl-function-info*)
 186           (fortran-to-lisp::make-f2cl-finfo
 187            :arg-types '((array double-float (*))
 188                         (array fortran-to-lisp::integer4 (*))
 189                         (fortran-to-lisp::integer4))
 190            :return-values '(nil nil nil)
 191            :calls 'nil)))
 192