share/hompack/lisp/gfunp.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-2020-04 (21D 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 double-float))
  16
  17 (in-package "HOMPACK")
  18
  19
  20 (defun gfunp (n ideg pdg qdg x xdgm1 xdg pxdgm1 pxdg g dg)
  21   (declare (type (array double-float (*)) dg g pxdg pxdgm1 xdg xdgm1 x qdg pdg)
  22            (type (array f2cl-lib:integer4 (*)) ideg)
  23            (type (f2cl-lib:integer4) n))
  24   (f2cl-lib:with-multi-array-data
  25       ((ideg f2cl-lib:integer4 ideg-%data% ideg-%offset%)
  26        (pdg double-float pdg-%data% pdg-%offset%)
  27        (qdg double-float qdg-%data% qdg-%offset%)
  28        (x double-float x-%data% x-%offset%)
  29        (xdgm1 double-float xdgm1-%data% xdgm1-%offset%)
  30        (xdg double-float xdg-%data% xdg-%offset%)
  31        (pxdgm1 double-float pxdgm1-%data% pxdgm1-%offset%)
  32        (pxdg double-float pxdg-%data% pxdg-%offset%)
  33        (g double-float g-%data% g-%offset%)
  34        (dg double-float dg-%data% dg-%offset%))
  35     (prog ((i 0) (j 0))
  36       (declare (type (f2cl-lib:integer4) j i))
  37       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  38                     ((> j n) nil)
  39         (tagbody
  40           (powp
  41            (f2cl-lib:int-sub
  42             (f2cl-lib:fref ideg-%data% (j) ((1 n)) ideg-%offset%)
  43             1)
  44            (f2cl-lib:array-slice x-%data%
  45                                  double-float
  46                                  (1 j)
  47                                  ((1 2) (1 n))
  48                                  x-%offset%)
  49            (f2cl-lib:array-slice xdgm1-%data%
  50                                  double-float
  51                                  (1 j)
  52                                  ((1 2) (1 n))
  53                                  xdgm1-%offset%))
  54           (mulp
  55            (f2cl-lib:array-slice x-%data%
  56                                  double-float
  57                                  (1 j)
  58                                  ((1 2) (1 n))
  59                                  x-%offset%)
  60            (f2cl-lib:array-slice xdgm1-%data%
  61                                  double-float
  62                                  (1 j)
  63                                  ((1 2) (1 n))
  64                                  xdgm1-%offset%)
  65            (f2cl-lib:array-slice xdg-%data%
  66                                  double-float
  67                                  (1 j)
  68                                  ((1 2) (1 n))
  69                                  xdg-%offset%))
  70          label5))
  71       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  72                     ((> j n) nil)
  73         (tagbody
  74           (mulp
  75            (f2cl-lib:array-slice pdg-%data%
  76                                  double-float
  77                                  (1 j)
  78                                  ((1 2) (1 n))
  79                                  pdg-%offset%)
  80            (f2cl-lib:array-slice xdgm1-%data%
  81                                  double-float
  82                                  (1 j)
  83                                  ((1 2) (1 n))
  84                                  xdgm1-%offset%)
  85            (f2cl-lib:array-slice pxdgm1-%data%
  86                                  double-float
  87                                  (1 j)
  88                                  ((1 2) (1 n))
  89                                  pxdgm1-%offset%))
  90          label10))
  91       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  92                     ((> j n) nil)
  93         (tagbody
  94           (mulp
  95            (f2cl-lib:array-slice pdg-%data%
  96                                  double-float
  97                                  (1 j)
  98                                  ((1 2) (1 n))
  99                                  pdg-%offset%)
 100            (f2cl-lib:array-slice xdg-%data%
 101                                  double-float
 102                                  (1 j)
 103                                  ((1 2) (1 n))
 104                                  xdg-%offset%)
 105            (f2cl-lib:array-slice pxdg-%data%
 106                                  double-float
 107                                  (1 j)
 108                                  ((1 2) (1 n))
 109                                  pxdg-%offset%))
 110          label20))
 111       (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 112                     ((> j n) nil)
 113         (tagbody
 114           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 115                         ((> i 2) nil)
 116             (tagbody
 117               (setf (f2cl-lib:fref g-%data% (i j) ((1 2) (1 n)) g-%offset%)
 118                       (-
 119                        (f2cl-lib:fref pxdg-%data%
 120                                       (i j)
 121                                       ((1 2) (1 n))
 122                                       pxdg-%offset%)
 123                        (f2cl-lib:fref qdg-%data%
 124                                       (i j)
 125                                       ((1 2) (1 n))
 126                                       qdg-%offset%)))
 127               (setf (f2cl-lib:fref dg-%data% (i j) ((1 2) (1 n)) dg-%offset%)
 128                       (* (f2cl-lib:fref ideg-%data% (j) ((1 n)) ideg-%offset%)
 129                          (f2cl-lib:fref pxdgm1-%data%
 130                                         (i j)
 131                                         ((1 2) (1 n))
 132                                         pxdgm1-%offset%)))
 133              label30))))
 134      label30
 135       (go end_label)
 136      end_label
 137       (return (values nil nil nil nil nil nil nil nil nil nil nil)))))
 138
 139 (in-package #:cl-user)
 140 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 141 (eval-when (:load-toplevel :compile-toplevel :execute)
 142   (setf (gethash 'fortran-to-lisp::gfunp fortran-to-lisp::*f2cl-function-info*)
 143           (fortran-to-lisp::make-f2cl-finfo
 144            :arg-types '((fortran-to-lisp::integer4)
 145                         (array fortran-to-lisp::integer4 (*))
 146                         (array double-float (*)) (array double-float (*))
 147                         (array double-float (*)) (array double-float (*))
 148                         (array double-float (*)) (array double-float (*))
 149                         (array double-float (*)) (array double-float (*))
 150                         (array double-float (*)))
 151            :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
 152            :calls '(fortran-to-lisp::mulp fortran-to-lisp::powp))))
 153