share/fftpack5/lisp/c1f2kb.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 single-float))
  16
  17 (in-package "FFTPACK5")
  18
  19
  20 (defun c1f2kb (ido l1 na cc in1 ch in2 wa)
  21   (declare (type (array double-float (*)) wa ch cc)
  22            (type (f2cl-lib:integer4) in2 in1 na l1 ido))
  23   (f2cl-lib:with-multi-array-data
  24       ((cc double-float cc-%data% cc-%offset%)
  25        (ch double-float ch-%data% ch-%offset%)
  26        (wa double-float wa-%data% wa-%offset%))
  27     (prog ((ti2 0.0d0) (tr2 0.0d0) (i 0) (chold2 0.0d0) (chold1 0.0d0) (k 0))
  28       (declare (type (f2cl-lib:integer4) k i)
  29                (type (double-float) chold1 chold2 tr2 ti2))
  30       (if (or (> ido 1) (= na 1)) (go label102))
  31       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
  32                     ((> k l1) nil)
  33         (tagbody
  34           (setf chold1
  35                   (+
  36                    (f2cl-lib:fref cc-%data%
  37                                   (1 k 1 1)
  38                                   ((1 in1) (1 l1) (1 ido) (1 2))
  39                                   cc-%offset%)
  40                    (f2cl-lib:fref cc-%data%
  41                                   (1 k 1 2)
  42                                   ((1 in1) (1 l1) (1 ido) (1 2))
  43                                   cc-%offset%)))
  44           (setf (f2cl-lib:fref cc-%data%
  45                                (1 k 1 2)
  46                                ((1 in1) (1 l1) (1 ido) (1 2))
  47                                cc-%offset%)
  48                   (-
  49                    (f2cl-lib:fref cc-%data%
  50                                   (1 k 1 1)
  51                                   ((1 in1) (1 l1) (1 ido) (1 2))
  52                                   cc-%offset%)
  53                    (f2cl-lib:fref cc-%data%
  54                                   (1 k 1 2)
  55                                   ((1 in1) (1 l1) (1 ido) (1 2))
  56                                   cc-%offset%)))
  57           (setf (f2cl-lib:fref cc-%data%
  58                                (1 k 1 1)
  59                                ((1 in1) (1 l1) (1 ido) (1 2))
  60                                cc-%offset%)
  61                   chold1)
  62           (setf chold2
  63                   (+
  64                    (f2cl-lib:fref cc-%data%
  65                                   (2 k 1 1)
  66                                   ((1 in1) (1 l1) (1 ido) (1 2))
  67                                   cc-%offset%)
  68                    (f2cl-lib:fref cc-%data%
  69                                   (2 k 1 2)
  70                                   ((1 in1) (1 l1) (1 ido) (1 2))
  71                                   cc-%offset%)))
  72           (setf (f2cl-lib:fref cc-%data%
  73                                (2 k 1 2)
  74                                ((1 in1) (1 l1) (1 ido) (1 2))
  75                                cc-%offset%)
  76                   (-
  77                    (f2cl-lib:fref cc-%data%
  78                                   (2 k 1 1)
  79                                   ((1 in1) (1 l1) (1 ido) (1 2))
  80                                   cc-%offset%)
  81                    (f2cl-lib:fref cc-%data%
  82                                   (2 k 1 2)
  83                                   ((1 in1) (1 l1) (1 ido) (1 2))
  84                                   cc-%offset%)))
  85           (setf (f2cl-lib:fref cc-%data%
  86                                (2 k 1 1)
  87                                ((1 in1) (1 l1) (1 ido) (1 2))
  88                                cc-%offset%)
  89                   chold2)
  90          label101))
  91       (go end_label)
  92      label102
  93       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
  94                     ((> k l1) nil)
  95         (tagbody
  96           (setf (f2cl-lib:fref ch-%data%
  97                                (1 k 1 1)
  98                                ((1 in2) (1 l1) (1 2) (1 ido))
  99                                ch-%offset%)
 100                   (+
 101                    (f2cl-lib:fref cc-%data%
 102                                   (1 k 1 1)
 103                                   ((1 in1) (1 l1) (1 ido) (1 2))
 104                                   cc-%offset%)
 105                    (f2cl-lib:fref cc-%data%
 106                                   (1 k 1 2)
 107                                   ((1 in1) (1 l1) (1 ido) (1 2))
 108                                   cc-%offset%)))
 109           (setf (f2cl-lib:fref ch-%data%
 110                                (1 k 2 1)
 111                                ((1 in2) (1 l1) (1 2) (1 ido))
 112                                ch-%offset%)
 113                   (-
 114                    (f2cl-lib:fref cc-%data%
 115                                   (1 k 1 1)
 116                                   ((1 in1) (1 l1) (1 ido) (1 2))
 117                                   cc-%offset%)
 118                    (f2cl-lib:fref cc-%data%
 119                                   (1 k 1 2)
 120                                   ((1 in1) (1 l1) (1 ido) (1 2))
 121                                   cc-%offset%)))
 122           (setf (f2cl-lib:fref ch-%data%
 123                                (2 k 1 1)
 124                                ((1 in2) (1 l1) (1 2) (1 ido))
 125                                ch-%offset%)
 126                   (+
 127                    (f2cl-lib:fref cc-%data%
 128                                   (2 k 1 1)
 129                                   ((1 in1) (1 l1) (1 ido) (1 2))
 130                                   cc-%offset%)
 131                    (f2cl-lib:fref cc-%data%
 132                                   (2 k 1 2)
 133                                   ((1 in1) (1 l1) (1 ido) (1 2))
 134                                   cc-%offset%)))
 135           (setf (f2cl-lib:fref ch-%data%
 136                                (2 k 2 1)
 137                                ((1 in2) (1 l1) (1 2) (1 ido))
 138                                ch-%offset%)
 139                   (-
 140                    (f2cl-lib:fref cc-%data%
 141                                   (2 k 1 1)
 142                                   ((1 in1) (1 l1) (1 ido) (1 2))
 143                                   cc-%offset%)
 144                    (f2cl-lib:fref cc-%data%
 145                                   (2 k 1 2)
 146                                   ((1 in1) (1 l1) (1 ido) (1 2))
 147                                   cc-%offset%)))
 148          label103))
 149       (if (= ido 1) (go end_label))
 150       (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1))
 151                     ((> i ido) nil)
 152         (tagbody
 153           (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 154                         ((> k l1) nil)
 155             (tagbody
 156               (setf (f2cl-lib:fref ch-%data%
 157                                    (1 k 1 i)
 158                                    ((1 in2) (1 l1) (1 2) (1 ido))
 159                                    ch-%offset%)
 160                       (+
 161                        (f2cl-lib:fref cc-%data%
 162                                       (1 k i 1)
 163                                       ((1 in1) (1 l1) (1 ido) (1 2))
 164                                       cc-%offset%)
 165                        (f2cl-lib:fref cc-%data%
 166                                       (1 k i 2)
 167                                       ((1 in1) (1 l1) (1 ido) (1 2))
 168                                       cc-%offset%)))
 169               (setf tr2
 170                       (-
 171                        (f2cl-lib:fref cc-%data%
 172                                       (1 k i 1)
 173                                       ((1 in1) (1 l1) (1 ido) (1 2))
 174                                       cc-%offset%)
 175                        (f2cl-lib:fref cc-%data%
 176                                       (1 k i 2)
 177                                       ((1 in1) (1 l1) (1 ido) (1 2))
 178                                       cc-%offset%)))
 179               (setf (f2cl-lib:fref ch-%data%
 180                                    (2 k 1 i)
 181                                    ((1 in2) (1 l1) (1 2) (1 ido))
 182                                    ch-%offset%)
 183                       (+
 184                        (f2cl-lib:fref cc-%data%
 185                                       (2 k i 1)
 186                                       ((1 in1) (1 l1) (1 ido) (1 2))
 187                                       cc-%offset%)
 188                        (f2cl-lib:fref cc-%data%
 189                                       (2 k i 2)
 190                                       ((1 in1) (1 l1) (1 ido) (1 2))
 191                                       cc-%offset%)))
 192               (setf ti2
 193                       (-
 194                        (f2cl-lib:fref cc-%data%
 195                                       (2 k i 1)
 196                                       ((1 in1) (1 l1) (1 ido) (1 2))
 197                                       cc-%offset%)
 198                        (f2cl-lib:fref cc-%data%
 199                                       (2 k i 2)
 200                                       ((1 in1) (1 l1) (1 ido) (1 2))
 201                                       cc-%offset%)))
 202               (setf (f2cl-lib:fref ch-%data%
 203                                    (2 k 2 i)
 204                                    ((1 in2) (1 l1) (1 2) (1 ido))
 205                                    ch-%offset%)
 206                       (+
 207                        (*
 208                         (f2cl-lib:fref wa-%data%
 209                                        (i 1 1)
 210                                        ((1 ido) (1 1) (1 2))
 211                                        wa-%offset%)
 212                         ti2)
 213                        (*
 214                         (f2cl-lib:fref wa-%data%
 215                                        (i 1 2)
 216                                        ((1 ido) (1 1) (1 2))
 217                                        wa-%offset%)
 218                         tr2)))
 219               (setf (f2cl-lib:fref ch-%data%
 220                                    (1 k 2 i)
 221                                    ((1 in2) (1 l1) (1 2) (1 ido))
 222                                    ch-%offset%)
 223                       (-
 224                        (*
 225                         (f2cl-lib:fref wa-%data%
 226                                        (i 1 1)
 227                                        ((1 ido) (1 1) (1 2))
 228                                        wa-%offset%)
 229                         tr2)
 230                        (*
 231                         (f2cl-lib:fref wa-%data%
 232                                        (i 1 2)
 233                                        ((1 ido) (1 1) (1 2))
 234                                        wa-%offset%)
 235                         ti2)))
 236              label104))
 237          label105))
 238       (go end_label)
 239      end_label
 240       (return (values nil nil nil nil nil nil nil nil)))))
 241
 242 (in-package #:cl-user)
 243 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 244 (eval-when (:load-toplevel :compile-toplevel :execute)
 245   (setf (gethash 'fortran-to-lisp::c1f2kb
 246                  fortran-to-lisp::*f2cl-function-info*)
 247           (fortran-to-lisp::make-f2cl-finfo
 248            :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 249                         (fortran-to-lisp::integer4) (array double-float (*))
 250                         (fortran-to-lisp::integer4) (array double-float (*))
 251                         (fortran-to-lisp::integer4) (array double-float (*)))
 252            :return-values '(nil nil nil nil nil nil nil nil)
 253            :calls 'nil)))
 254