share/fftpack5/lisp/r1f2kb.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 r1f2kb (ido l1 cc in1 ch in2 wa1)
  21   (declare (type (array double-float (*)) wa1 ch cc)
  22            (type (f2cl-lib:integer4) in2 in1 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        (wa1 double-float wa1-%data% wa1-%offset%))
  27     (prog ((ic 0) (i 0) (idp2 0) (k 0))
  28       (declare (type (f2cl-lib:integer4) k idp2 i ic))
  29       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
  30                     ((> k l1) nil)
  31         (tagbody
  32           (setf (f2cl-lib:fref ch-%data%
  33                                (1 1 k 1)
  34                                ((1 in2) (1 ido) (1 l1) (1 2))
  35                                ch-%offset%)
  36                   (+
  37                    (f2cl-lib:fref cc-%data%
  38                                   (1 1 1 k)
  39                                   ((1 in1) (1 ido) (1 2) (1 l1))
  40                                   cc-%offset%)
  41                    (f2cl-lib:fref cc-%data%
  42                                   (1 ido 2 k)
  43                                   ((1 in1) (1 ido) (1 2) (1 l1))
  44                                   cc-%offset%)))
  45           (setf (f2cl-lib:fref ch-%data%
  46                                (1 1 k 2)
  47                                ((1 in2) (1 ido) (1 l1) (1 2))
  48                                ch-%offset%)
  49                   (-
  50                    (f2cl-lib:fref cc-%data%
  51                                   (1 1 1 k)
  52                                   ((1 in1) (1 ido) (1 2) (1 l1))
  53                                   cc-%offset%)
  54                    (f2cl-lib:fref cc-%data%
  55                                   (1 ido 2 k)
  56                                   ((1 in1) (1 ido) (1 2) (1 l1))
  57                                   cc-%offset%)))
  58          label101))
  59       (f2cl-lib:arithmetic-if (f2cl-lib:int-sub ido 2)
  60                               (go label107)
  61                               (go label105)
  62                               (go label102))
  63      label102
  64       (setf idp2 (f2cl-lib:int-add ido 2))
  65       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
  66                     ((> k l1) nil)
  67         (tagbody
  68           (f2cl-lib:fdo (i 3 (f2cl-lib:int-add i 2))
  69                         ((> i ido) nil)
  70             (tagbody
  71               (setf ic (f2cl-lib:int-sub idp2 i))
  72               (setf (f2cl-lib:fref ch-%data%
  73                                    (1 (f2cl-lib:int-sub i 1) k 1)
  74                                    ((1 in2) (1 ido) (1 l1) (1 2))
  75                                    ch-%offset%)
  76                       (+
  77                        (f2cl-lib:fref cc-%data%
  78                                       (1 (f2cl-lib:int-sub i 1) 1 k)
  79                                       ((1 in1) (1 ido) (1 2) (1 l1))
  80                                       cc-%offset%)
  81                        (f2cl-lib:fref cc-%data%
  82                                       (1 (f2cl-lib:int-sub ic 1) 2 k)
  83                                       ((1 in1) (1 ido) (1 2) (1 l1))
  84                                       cc-%offset%)))
  85               (setf (f2cl-lib:fref ch-%data%
  86                                    (1 i k 1)
  87                                    ((1 in2) (1 ido) (1 l1) (1 2))
  88                                    ch-%offset%)
  89                       (-
  90                        (f2cl-lib:fref cc-%data%
  91                                       (1 i 1 k)
  92                                       ((1 in1) (1 ido) (1 2) (1 l1))
  93                                       cc-%offset%)
  94                        (f2cl-lib:fref cc-%data%
  95                                       (1 ic 2 k)
  96                                       ((1 in1) (1 ido) (1 2) (1 l1))
  97                                       cc-%offset%)))
  98               (setf (f2cl-lib:fref ch-%data%
  99                                    (1 (f2cl-lib:int-sub i 1) k 2)
 100                                    ((1 in2) (1 ido) (1 l1) (1 2))
 101                                    ch-%offset%)
 102                       (-
 103                        (*
 104                         (f2cl-lib:fref wa1-%data%
 105                                        ((f2cl-lib:int-sub i 2))
 106                                        ((1 ido))
 107                                        wa1-%offset%)
 108                         (-
 109                          (f2cl-lib:fref cc-%data%
 110                                         (1 (f2cl-lib:int-sub i 1) 1 k)
 111                                         ((1 in1) (1 ido) (1 2) (1 l1))
 112                                         cc-%offset%)
 113                          (f2cl-lib:fref cc-%data%
 114                                         (1 (f2cl-lib:int-sub ic 1) 2 k)
 115                                         ((1 in1) (1 ido) (1 2) (1 l1))
 116                                         cc-%offset%)))
 117                        (*
 118                         (f2cl-lib:fref wa1-%data%
 119                                        ((f2cl-lib:int-sub i 1))
 120                                        ((1 ido))
 121                                        wa1-%offset%)
 122                         (+
 123                          (f2cl-lib:fref cc-%data%
 124                                         (1 i 1 k)
 125                                         ((1 in1) (1 ido) (1 2) (1 l1))
 126                                         cc-%offset%)
 127                          (f2cl-lib:fref cc-%data%
 128                                         (1 ic 2 k)
 129                                         ((1 in1) (1 ido) (1 2) (1 l1))
 130                                         cc-%offset%)))))
 131               (setf (f2cl-lib:fref ch-%data%
 132                                    (1 i k 2)
 133                                    ((1 in2) (1 ido) (1 l1) (1 2))
 134                                    ch-%offset%)
 135                       (+
 136                        (*
 137                         (f2cl-lib:fref wa1-%data%
 138                                        ((f2cl-lib:int-sub i 2))
 139                                        ((1 ido))
 140                                        wa1-%offset%)
 141                         (+
 142                          (f2cl-lib:fref cc-%data%
 143                                         (1 i 1 k)
 144                                         ((1 in1) (1 ido) (1 2) (1 l1))
 145                                         cc-%offset%)
 146                          (f2cl-lib:fref cc-%data%
 147                                         (1 ic 2 k)
 148                                         ((1 in1) (1 ido) (1 2) (1 l1))
 149                                         cc-%offset%)))
 150                        (*
 151                         (f2cl-lib:fref wa1-%data%
 152                                        ((f2cl-lib:int-sub i 1))
 153                                        ((1 ido))
 154                                        wa1-%offset%)
 155                         (-
 156                          (f2cl-lib:fref cc-%data%
 157                                         (1 (f2cl-lib:int-sub i 1) 1 k)
 158                                         ((1 in1) (1 ido) (1 2) (1 l1))
 159                                         cc-%offset%)
 160                          (f2cl-lib:fref cc-%data%
 161                                         (1 (f2cl-lib:int-sub ic 1) 2 k)
 162                                         ((1 in1) (1 ido) (1 2) (1 l1))
 163                                         cc-%offset%)))))
 164              label103))
 165          label104))
 166       (if (= (mod ido 2) 1) (go end_label))
 167      label105
 168       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 169                     ((> k l1) nil)
 170         (tagbody
 171           (setf (f2cl-lib:fref ch-%data%
 172                                (1 ido k 1)
 173                                ((1 in2) (1 ido) (1 l1) (1 2))
 174                                ch-%offset%)
 175                   (+
 176                    (f2cl-lib:fref cc-%data%
 177                                   (1 ido 1 k)
 178                                   ((1 in1) (1 ido) (1 2) (1 l1))
 179                                   cc-%offset%)
 180                    (f2cl-lib:fref cc-%data%
 181                                   (1 ido 1 k)
 182                                   ((1 in1) (1 ido) (1 2) (1 l1))
 183                                   cc-%offset%)))
 184           (setf (f2cl-lib:fref ch-%data%
 185                                (1 ido k 2)
 186                                ((1 in2) (1 ido) (1 l1) (1 2))
 187                                ch-%offset%)
 188                   (-
 189                    (+
 190                     (f2cl-lib:fref cc-%data%
 191                                    (1 1 2 k)
 192                                    ((1 in1) (1 ido) (1 2) (1 l1))
 193                                    cc-%offset%)
 194                     (f2cl-lib:fref cc-%data%
 195                                    (1 1 2 k)
 196                                    ((1 in1) (1 ido) (1 2) (1 l1))
 197                                    cc-%offset%))))
 198          label106))
 199      label107
 200       (go end_label)
 201      end_label
 202       (return (values nil nil nil nil nil nil nil)))))
 203
 204 (in-package #:cl-user)
 205 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 206 (eval-when (:load-toplevel :compile-toplevel :execute)
 207   (setf (gethash 'fortran-to-lisp::r1f2kb
 208                  fortran-to-lisp::*f2cl-function-info*)
 209           (fortran-to-lisp::make-f2cl-finfo
 210            :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 211                         (array double-float (*)) (fortran-to-lisp::integer4)
 212                         (array double-float (*)) (fortran-to-lisp::integer4)
 213                         (array double-float (*)))
 214            :return-values '(nil nil nil nil nil nil nil)
 215            :calls 'nil)))
 216