share/odepack/src/dsolbt.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 dsolbt (m n a b c y ip)
  21   (declare (type (array f2cl-lib:integer4 (*)) ip)
  22            (type (array double-float (*)) y c b a)
  23            (type (f2cl-lib:integer4) n m))
  24   (f2cl-lib:with-multi-array-data
  25       ((a double-float a-%data% a-%offset%)
  26        (b double-float b-%data% b-%offset%)
  27        (c double-float c-%data% c-%offset%)
  28        (y double-float y-%data% y-%offset%)
  29        (ip f2cl-lib:integer4 ip-%data% ip-%offset%))
  30     (prog ((dp 0.0d0) (nm1 0) (nm2 0) (i 0) (k 0) (kb 0) (km1 0) (kp1 0))
  31       (declare (type (f2cl-lib:integer4) kp1 km1 kb k i nm2 nm1)
  32                (type (double-float) dp))
  33       (setf nm1 (f2cl-lib:int-sub n 1))
  34       (setf nm2 (f2cl-lib:int-sub n 2))
  35       (dgesl a m m ip y 0)
  36       (f2cl-lib:fdo (k 2 (f2cl-lib:int-add k 1))
  37                     ((> k nm1) nil)
  38         (tagbody
  39           (setf km1 (f2cl-lib:int-sub k 1))
  40           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  41                         ((> i m) nil)
  42             (tagbody
  43               (setf dp
  44                       (ddot m
  45                        (f2cl-lib:array-slice c-%data%
  46                                              double-float
  47                                              (i 1 k)
  48                                              ((1 m) (1 m) (1 n))
  49                                              c-%offset%)
  50                        m
  51                        (f2cl-lib:array-slice y-%data%
  52                                              double-float
  53                                              (1 km1)
  54                                              ((1 m) (1 n))
  55                                              y-%offset%)
  56                        1))
  57               (setf (f2cl-lib:fref y-%data% (i k) ((1 m) (1 n)) y-%offset%)
  58                       (-
  59                        (f2cl-lib:fref y-%data% (i k) ((1 m) (1 n)) y-%offset%)
  60                        dp))
  61              label20))
  62           (dgesl
  63            (f2cl-lib:array-slice a-%data%
  64                                  double-float
  65                                  (1 1 k)
  66                                  ((1 m) (1 m) (1 n))
  67                                  a-%offset%)
  68            m m
  69            (f2cl-lib:array-slice ip-%data%
  70                                  f2cl-lib:integer4
  71                                  (1 k)
  72                                  ((1 m) (1 n))
  73                                  ip-%offset%)
  74            (f2cl-lib:array-slice y-%data%
  75                                  double-float
  76                                  (1 k)
  77                                  ((1 m) (1 n))
  78                                  y-%offset%)
  79            0)
  80          label30))
  81       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  82                     ((> i m) nil)
  83         (tagbody
  84           (setf dp
  85                   (+
  86                    (ddot m
  87                     (f2cl-lib:array-slice c-%data%
  88                                           double-float
  89                                           (i 1 n)
  90                                           ((1 m) (1 m) (1 n))
  91                                           c-%offset%)
  92                     m
  93                     (f2cl-lib:array-slice y-%data%
  94                                           double-float
  95                                           (1 nm1)
  96                                           ((1 m) (1 n))
  97                                           y-%offset%)
  98                     1)
  99                    (ddot m
 100                     (f2cl-lib:array-slice b-%data%
 101                                           double-float
 102                                           (i 1 n)
 103                                           ((1 m) (1 m) (1 n))
 104                                           b-%offset%)
 105                     m
 106                     (f2cl-lib:array-slice y-%data%
 107                                           double-float
 108                                           (1 nm2)
 109                                           ((1 m) (1 n))
 110                                           y-%offset%)
 111                     1)))
 112           (setf (f2cl-lib:fref y-%data% (i n) ((1 m) (1 n)) y-%offset%)
 113                   (- (f2cl-lib:fref y-%data% (i n) ((1 m) (1 n)) y-%offset%)
 114                      dp))
 115          label50))
 116       (dgesl
 117        (f2cl-lib:array-slice a-%data%
 118                              double-float
 119                              (1 1 n)
 120                              ((1 m) (1 m) (1 n))
 121                              a-%offset%)
 122        m m
 123        (f2cl-lib:array-slice ip-%data%
 124                              f2cl-lib:integer4
 125                              (1 n)
 126                              ((1 m) (1 n))
 127                              ip-%offset%)
 128        (f2cl-lib:array-slice y-%data%
 129                              double-float
 130                              (1 n)
 131                              ((1 m) (1 n))
 132                              y-%offset%)
 133        0)
 134       (f2cl-lib:fdo (kb 1 (f2cl-lib:int-add kb 1))
 135                     ((> kb nm1) nil)
 136         (tagbody
 137           (setf k (f2cl-lib:int-sub n kb))
 138           (setf kp1 (f2cl-lib:int-add k 1))
 139           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 140                         ((> i m) nil)
 141             (tagbody
 142               (setf dp
 143                       (ddot m
 144                        (f2cl-lib:array-slice b-%data%
 145                                              double-float
 146                                              (i 1 k)
 147                                              ((1 m) (1 m) (1 n))
 148                                              b-%offset%)
 149                        m
 150                        (f2cl-lib:array-slice y-%data%
 151                                              double-float
 152                                              (1 kp1)
 153                                              ((1 m) (1 n))
 154                                              y-%offset%)
 155                        1))
 156               (setf (f2cl-lib:fref y-%data% (i k) ((1 m) (1 n)) y-%offset%)
 157                       (-
 158                        (f2cl-lib:fref y-%data% (i k) ((1 m) (1 n)) y-%offset%)
 159                        dp))
 160              label70))
 161          label80))
 162       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 163                     ((> i m) nil)
 164         (tagbody
 165           (setf dp
 166                   (ddot m
 167                    (f2cl-lib:array-slice c-%data%
 168                                          double-float
 169                                          (i 1 1)
 170                                          ((1 m) (1 m) (1 n))
 171                                          c-%offset%)
 172                    m
 173                    (f2cl-lib:array-slice y-%data%
 174                                          double-float
 175                                          (1 3)
 176                                          ((1 m) (1 n))
 177                                          y-%offset%)
 178                    1))
 179           (setf (f2cl-lib:fref y-%data% (i 1) ((1 m) (1 n)) y-%offset%)
 180                   (- (f2cl-lib:fref y-%data% (i 1) ((1 m) (1 n)) y-%offset%)
 181                      dp))
 182          label100))
 183       (go end_label)
 184      end_label
 185       (return (values nil nil nil nil nil nil nil)))))
 186
 187 (in-package #:cl-user)
 188 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 189 (eval-when (:load-toplevel :compile-toplevel :execute)
 190   (setf (gethash 'fortran-to-lisp::dsolbt
 191                  fortran-to-lisp::*f2cl-function-info*)
 192           (fortran-to-lisp::make-f2cl-finfo
 193            :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 194                         (array double-float (*)) (array double-float (*))
 195                         (array double-float (*)) (array double-float (*))
 196                         (array fortran-to-lisp::integer4 (*)))
 197            :return-values '(nil nil nil nil nil nil nil)
 198            :calls '(fortran-to-lisp::ddot fortran-to-lisp::dgesl))))
 199