share/odepack/src/ddecbt.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 ddecbt (m n a b c ip ier)
  21   (declare (type (array f2cl-lib:integer4 (*)) ip)
  22            (type (array double-float (*)) c b a)
  23            (type (f2cl-lib:integer4) ier 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        (ip f2cl-lib:integer4 ip-%data% ip-%offset%))
  29     (prog ((dp 0.0d0) (nm1 0) (nm2 0) (km1 0) (i 0) (j 0) (k 0))
  30       (declare (type (f2cl-lib:integer4) k j i km1 nm2 nm1)
  31                (type (double-float) dp))
  32       (if (or (< m 1) (< n 4)) (go label210))
  33       (setf nm1 (f2cl-lib:int-sub n 1))
  34       (setf nm2 (f2cl-lib:int-sub n 2))
  35       (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
  36           (dgefa a m m ip ier)
  37         (declare (ignore var-0 var-1 var-2 var-3))
  38         (setf ier var-4))
  39       (setf k 1)
  40       (if (/= ier 0) (go label200))
  41       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  42                     ((> j m) nil)
  43         (tagbody
  44           (dgesl a m m ip
  45            (f2cl-lib:array-slice b-%data%
  46                                  double-float
  47                                  (1 j 1)
  48                                  ((1 m) (1 m) (1 n))
  49                                  b-%offset%)
  50            0)
  51           (dgesl a m m ip
  52            (f2cl-lib:array-slice c-%data%
  53                                  double-float
  54                                  (1 j 1)
  55                                  ((1 m) (1 m) (1 n))
  56                                  c-%offset%)
  57            0)
  58          label10))
  59       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  60                     ((> j m) nil)
  61         (tagbody
  62           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  63                         ((> i m) nil)
  64             (tagbody
  65               (setf dp
  66                       (ddot m
  67                        (f2cl-lib:array-slice c-%data%
  68                                              double-float
  69                                              (i 1 2)
  70                                              ((1 m) (1 m) (1 n))
  71                                              c-%offset%)
  72                        m
  73                        (f2cl-lib:array-slice c-%data%
  74                                              double-float
  75                                              (1 j 1)
  76                                              ((1 m) (1 m) (1 n))
  77                                              c-%offset%)
  78                        1))
  79               (setf (f2cl-lib:fref b-%data%
  80                                    (i j 2)
  81                                    ((1 m) (1 m) (1 n))
  82                                    b-%offset%)
  83                       (-
  84                        (f2cl-lib:fref b-%data%
  85                                       (i j 2)
  86                                       ((1 m) (1 m) (1 n))
  87                                       b-%offset%)
  88                        dp))
  89              label30))
  90          label40))
  91       (f2cl-lib:fdo (k 2 (f2cl-lib:int-add k 1))
  92                     ((> k nm1) nil)
  93         (tagbody
  94           (setf km1 (f2cl-lib:int-sub k 1))
  95           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  96                         ((> j m) nil)
  97             (tagbody
  98               (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  99                             ((> i m) nil)
 100                 (tagbody
 101                   (setf dp
 102                           (ddot m
 103                            (f2cl-lib:array-slice c-%data%
 104                                                  double-float
 105                                                  (i 1 k)
 106                                                  ((1 m) (1 m) (1 n))
 107                                                  c-%offset%)
 108                            m
 109                            (f2cl-lib:array-slice b-%data%
 110                                                  double-float
 111                                                  (1 j km1)
 112                                                  ((1 m) (1 m) (1 n))
 113                                                  b-%offset%)
 114                            1))
 115                   (setf (f2cl-lib:fref a-%data%
 116                                        (i j k)
 117                                        ((1 m) (1 m) (1 n))
 118                                        a-%offset%)
 119                           (-
 120                            (f2cl-lib:fref a-%data%
 121                                           (i j k)
 122                                           ((1 m) (1 m) (1 n))
 123                                           a-%offset%)
 124                            dp))
 125                  label60))
 126              label70))
 127           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
 128               (dgefa
 129                (f2cl-lib:array-slice a-%data%
 130                                      double-float
 131                                      (1 1 k)
 132                                      ((1 m) (1 m) (1 n))
 133                                      a-%offset%)
 134                m m
 135                (f2cl-lib:array-slice ip-%data%
 136                                      f2cl-lib:integer4
 137                                      (1 k)
 138                                      ((1 m) (1 n))
 139                                      ip-%offset%)
 140                ier)
 141             (declare (ignore var-0 var-1 var-2 var-3))
 142             (setf ier var-4))
 143           (if (/= ier 0) (go label200))
 144           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 145                         ((> j m) nil)
 146             (tagbody
 147              label80
 148               (dgesl
 149                (f2cl-lib:array-slice a-%data%
 150                                      double-float
 151                                      (1 1 k)
 152                                      ((1 m) (1 m) (1 n))
 153                                      a-%offset%)
 154                m m
 155                (f2cl-lib:array-slice ip-%data%
 156                                      f2cl-lib:integer4
 157                                      (1 k)
 158                                      ((1 m) (1 n))
 159                                      ip-%offset%)
 160                (f2cl-lib:array-slice b-%data%
 161                                      double-float
 162                                      (1 j k)
 163                                      ((1 m) (1 m) (1 n))
 164                                      b-%offset%)
 165                0)))
 166          label100))
 167       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 168                     ((> j m) nil)
 169         (tagbody
 170           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 171                         ((> i m) nil)
 172             (tagbody
 173               (setf dp
 174                       (ddot m
 175                        (f2cl-lib:array-slice b-%data%
 176                                              double-float
 177                                              (i 1 n)
 178                                              ((1 m) (1 m) (1 n))
 179                                              b-%offset%)
 180                        m
 181                        (f2cl-lib:array-slice b-%data%
 182                                              double-float
 183                                              (1 j nm2)
 184                                              ((1 m) (1 m) (1 n))
 185                                              b-%offset%)
 186                        1))
 187               (setf (f2cl-lib:fref c-%data%
 188                                    (i j n)
 189                                    ((1 m) (1 m) (1 n))
 190                                    c-%offset%)
 191                       (-
 192                        (f2cl-lib:fref c-%data%
 193                                       (i j n)
 194                                       ((1 m) (1 m) (1 n))
 195                                       c-%offset%)
 196                        dp))
 197              label120))
 198          label130))
 199       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 200                     ((> j m) nil)
 201         (tagbody
 202           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 203                         ((> i m) nil)
 204             (tagbody
 205               (setf dp
 206                       (ddot m
 207                        (f2cl-lib:array-slice c-%data%
 208                                              double-float
 209                                              (i 1 n)
 210                                              ((1 m) (1 m) (1 n))
 211                                              c-%offset%)
 212                        m
 213                        (f2cl-lib:array-slice b-%data%
 214                                              double-float
 215                                              (1 j nm1)
 216                                              ((1 m) (1 m) (1 n))
 217                                              b-%offset%)
 218                        1))
 219               (setf (f2cl-lib:fref a-%data%
 220                                    (i j n)
 221                                    ((1 m) (1 m) (1 n))
 222                                    a-%offset%)
 223                       (-
 224                        (f2cl-lib:fref a-%data%
 225                                       (i j n)
 226                                       ((1 m) (1 m) (1 n))
 227                                       a-%offset%)
 228                        dp))
 229              label150))
 230          label160))
 231       (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
 232           (dgefa
 233            (f2cl-lib:array-slice a-%data%
 234                                  double-float
 235                                  (1 1 n)
 236                                  ((1 m) (1 m) (1 n))
 237                                  a-%offset%)
 238            m m
 239            (f2cl-lib:array-slice ip-%data%
 240                                  f2cl-lib:integer4
 241                                  (1 n)
 242                                  ((1 m) (1 n))
 243                                  ip-%offset%)
 244            ier)
 245         (declare (ignore var-0 var-1 var-2 var-3))
 246         (setf ier var-4))
 247       (setf k n)
 248       (if (/= ier 0) (go label200))
 249       (go end_label)
 250      label200
 251       (setf ier k)
 252       (go end_label)
 253      label210
 254       (setf ier -1)
 255       (go end_label)
 256      end_label
 257       (return (values nil nil nil nil nil nil ier)))))
 258
 259 (in-package #:cl-user)
 260 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 261 (eval-when (:load-toplevel :compile-toplevel :execute)
 262   (setf (gethash 'fortran-to-lisp::ddecbt
 263                  fortran-to-lisp::*f2cl-function-info*)
 264           (fortran-to-lisp::make-f2cl-finfo
 265            :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 266                         (array double-float (*)) (array double-float (*))
 267                         (array double-float (*))
 268                         (array fortran-to-lisp::integer4 (*))
 269                         (fortran-to-lisp::integer4))
 270            :return-values '(nil nil nil nil nil nil fortran-to-lisp::ier)
 271            :calls '(fortran-to-lisp::ddot fortran-to-lisp::dgesl
 272                     fortran-to-lisp::dgefa))))
 273