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