share/odepack/src/dhels.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 dhels (a lda n q b)
  21   (declare (type (f2cl-lib:integer4) n lda)
  22            (type (array double-float (*)) b q a))
  23   (f2cl-lib:with-multi-array-data
  24       ((a double-float a-%data% a-%offset%)
  25        (q double-float q-%data% q-%offset%)
  26        (b double-float b-%data% b-%offset%))
  27     (prog ((c 0.0d0) (s 0.0d0) (t1 0.0d0) (t2 0.0d0) (iq 0) (k 0) (kb 0)
  28            (kp1 0) (t$ 0.0d0))
  29       (declare (type (f2cl-lib:integer4) kp1 kb k iq)
  30                (type (double-float) t$ t2 t1 s c))
  31       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
  32                     ((> k n) nil)
  33         (tagbody
  34           (setf kp1 (f2cl-lib:int-add k 1))
  35           (setf iq
  36                   (f2cl-lib:int-add (f2cl-lib:int-mul 2 (f2cl-lib:int-sub k 1))
  37                                     1))
  38           (setf c (f2cl-lib:fref q-%data% (iq) ((1 *)) q-%offset%))
  39           (setf s
  40                   (f2cl-lib:fref q-%data%
  41                                  ((f2cl-lib:int-add iq 1))
  42                                  ((1 *))
  43                                  q-%offset%))
  44           (setf t1 (f2cl-lib:fref b-%data% (k) ((1 *)) b-%offset%))
  45           (setf t2 (f2cl-lib:fref b-%data% (kp1) ((1 *)) b-%offset%))
  46           (setf (f2cl-lib:fref b-%data% (k) ((1 *)) b-%offset%)
  47                   (- (* c t1) (* s t2)))
  48           (setf (f2cl-lib:fref b-%data% (kp1) ((1 *)) b-%offset%)
  49                   (+ (* s t1) (* c t2)))
  50          label20))
  51       (f2cl-lib:fdo (kb 1 (f2cl-lib:int-add kb 1))
  52                     ((> kb n) nil)
  53         (tagbody
  54           (setf k (f2cl-lib:int-sub (f2cl-lib:int-add n 1) kb))
  55           (setf (f2cl-lib:fref b-%data% (k) ((1 *)) b-%offset%)
  56                   (/ (f2cl-lib:fref b-%data% (k) ((1 *)) b-%offset%)
  57                      (f2cl-lib:fref a-%data%
  58                                     (k k)
  59                                     ((1 lda) (1 *))
  60                                     a-%offset%)))
  61           (setf t$ (- (f2cl-lib:fref b-%data% (k) ((1 *)) b-%offset%)))
  62           (daxpy (f2cl-lib:int-sub k 1) t$
  63            (f2cl-lib:array-slice a-%data%
  64                                  double-float
  65                                  (1 k)
  66                                  ((1 lda) (1 *))
  67                                  a-%offset%)
  68            1
  69            (f2cl-lib:array-slice b-%data% double-float (1) ((1 *)) b-%offset%)
  70            1)
  71          label40))
  72       (go end_label)
  73      end_label
  74       (return (values nil nil nil nil nil)))))
  75
  76 (in-package #:cl-user)
  77 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
  78 (eval-when (:load-toplevel :compile-toplevel :execute)
  79   (setf (gethash 'fortran-to-lisp::dhels fortran-to-lisp::*f2cl-function-info*)
  80           (fortran-to-lisp::make-f2cl-finfo
  81            :arg-types '((array double-float (*)) (fortran-to-lisp::integer4)
  82                         (fortran-to-lisp::integer4) (array double-float (*))
  83                         (array double-float (*)))
  84            :return-values '(nil nil nil nil nil)
  85            :calls '(fortran-to-lisp::daxpy))))
  86