share/odepack/src/dusol.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 dusol
  21        (neq tn y savf b wght n delta hl0 mnewt psol npsl x wp iwp wk iflag)
  22   (declare (type (f2cl-lib:integer4) iflag npsl mnewt n)
  23            (type (array double-float (*)) wk wp x wght b savf y)
  24            (type (double-float) hl0 delta tn)
  25            (type (array f2cl-lib:integer4 (*)) iwp neq))
  26   (f2cl-lib:with-multi-array-data
  27       ((neq f2cl-lib:integer4 neq-%data% neq-%offset%)
  28        (iwp f2cl-lib:integer4 iwp-%data% iwp-%offset%)
  29        (y double-float y-%data% y-%offset%)
  30        (savf double-float savf-%data% savf-%offset%)
  31        (b double-float b-%data% b-%offset%)
  32        (wght double-float wght-%data% wght-%offset%)
  33        (x double-float x-%data% x-%offset%)
  34        (wp double-float wp-%data% wp-%offset%)
  35        (wk double-float wk-%data% wk-%offset%))
  36     (prog ((bnrm 0.0d0) (i 0) (ier 0))
  37       (declare (type (f2cl-lib:integer4) ier i) (type (double-float) bnrm))
  38       (setf iflag 0)
  39       (setf npsl 0)
  40       (setf bnrm (dvnorm n b wght))
  41       (if (> bnrm delta) (go label30))
  42       (if (> mnewt 0) (go label10))
  43       (dcopy n b 1 x 1)
  44       (go end_label)
  45      label10
  46       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  47                     ((> i n) nil)
  48         (tagbody
  49          label20
  50           (setf (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%) 0.0d0)))
  51       (go end_label)
  52      label30
  53       (setf ier 0)
  54       (multiple-value-bind
  55             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9
  56              var-10)
  57           (funcall psol neq tn y savf wk hl0 wp iwp b 0 ier)
  58         (declare (ignore var-0 var-2 var-3 var-4 var-6 var-7 var-8 var-9))
  59         (when var-1
  60           (setf tn var-1))
  61         (when var-5
  62           (setf hl0 var-5))
  63         (when var-10
  64           (setf ier var-10)))
  65       (setf npsl 1)
  66       (if (/= ier 0) (go label100))
  67       (dcopy n b 1 x 1)
  68       (go end_label)
  69      label100
  70       (if (< ier 0) (setf iflag -1))
  71       (if (> ier 0) (setf iflag 3))
  72       (go end_label)
  73      end_label
  74       (return
  75        (values nil
  76                tn
  77                nil
  78                nil
  79                nil
  80                nil
  81                nil
  82                nil
  83                hl0
  84                nil
  85                nil
  86                npsl
  87                nil
  88                nil
  89                nil
  90                nil
  91                iflag)))))
  92
  93 (in-package #:cl-user)
  94 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
  95 (eval-when (:load-toplevel :compile-toplevel :execute)
  96   (setf (gethash 'fortran-to-lisp::dusol fortran-to-lisp::*f2cl-function-info*)
  97           (fortran-to-lisp::make-f2cl-finfo
  98            :arg-types '((array fortran-to-lisp::integer4 (*)) (double-float)
  99                         (array double-float (*)) (array double-float (*))
 100                         (array double-float (*)) (array double-float (*))
 101                         (fortran-to-lisp::integer4) (double-float)
 102                         (double-float) (fortran-to-lisp::integer4) t
 103                         (fortran-to-lisp::integer4) (array double-float (*))
 104                         (array double-float (*))
 105                         (array fortran-to-lisp::integer4 (*))
 106                         (array double-float (*)) (fortran-to-lisp::integer4))
 107            :return-values '(nil fortran-to-lisp::tn nil nil nil nil nil nil
 108                             fortran-to-lisp::hl0 nil nil fortran-to-lisp::npsl
 109                             nil nil nil nil fortran-to-lisp::iflag)
 110            :calls '(fortran-to-lisp::dcopy fortran-to-lisp::dvnorm))))
 111