share/fftpack5/lisp/c1f2kf.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 c1f2kf (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            (sn 0.0d0))
  29       (declare (type (f2cl-lib:integer4) k i)
  30                (type (double-float) sn chold1 chold2 tr2 ti2))
  31       (if (> ido 1) (go label102))
  32       (setf sn (/ 1.0d0 (f2cl-lib:freal (f2cl-lib:int-mul 2 l1))))
  33       (if (= na 1) (go label106))
  34       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
  35                     ((> k l1) nil)
  36         (tagbody
  37           (setf chold1
  38                   (* sn
  39                      (+
  40                       (f2cl-lib:fref cc-%data%
  41                                      (1 k 1 1)
  42                                      ((1 in1) (1 l1) (1 ido) (1 2))
  43                                      cc-%offset%)
  44                       (f2cl-lib:fref cc-%data%
  45                                      (1 k 1 2)
  46                                      ((1 in1) (1 l1) (1 ido) (1 2))
  47                                      cc-%offset%))))
  48           (setf (f2cl-lib:fref cc-%data%
  49                                (1 k 1 2)
  50                                ((1 in1) (1 l1) (1 ido) (1 2))
  51                                cc-%offset%)
  52                   (* sn
  53                      (-
  54                       (f2cl-lib:fref cc-%data%
  55                                      (1 k 1 1)
  56                                      ((1 in1) (1 l1) (1 ido) (1 2))
  57                                      cc-%offset%)
  58                       (f2cl-lib:fref cc-%data%
  59                                      (1 k 1 2)
  60                                      ((1 in1) (1 l1) (1 ido) (1 2))
  61                                      cc-%offset%))))
  62           (setf (f2cl-lib:fref cc-%data%
  63                                (1 k 1 1)
  64                                ((1 in1) (1 l1) (1 ido) (1 2))
  65                                cc-%offset%)
  66                   chold1)
  67           (setf chold2
  68                   (* sn
  69                      (+
  70                       (f2cl-lib:fref cc-%data%
  71                                      (2 k 1 1)
  72                                      ((1 in1) (1 l1) (1 ido) (1 2))
  73                                      cc-%offset%)
  74                       (f2cl-lib:fref cc-%data%
  75                                      (2 k 1 2)
  76                                      ((1 in1) (1 l1) (1 ido) (1 2))
  77                                      cc-%offset%))))
  78           (setf (f2cl-lib:fref cc-%data%
  79                                (2 k 1 2)
  80                                ((1 in1) (1 l1) (1 ido) (1 2))
  81                                cc-%offset%)
  82                   (* sn
  83                      (-
  84                       (f2cl-lib:fref cc-%data%
  85                                      (2 k 1 1)
  86                                      ((1 in1) (1 l1) (1 ido) (1 2))
  87                                      cc-%offset%)
  88                       (f2cl-lib:fref cc-%data%
  89                                      (2 k 1 2)
  90                                      ((1 in1) (1 l1) (1 ido) (1 2))
  91                                      cc-%offset%))))
  92           (setf (f2cl-lib:fref cc-%data%
  93                                (2 k 1 1)
  94                                ((1 in1) (1 l1) (1 ido) (1 2))
  95                                cc-%offset%)
  96                   chold2)
  97          label101))
  98       (go end_label)
  99      label106
 100       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 101                     ((> k l1) nil)
 102         (tagbody
 103           (setf (f2cl-lib:fref ch-%data%
 104                                (1 k 1 1)
 105                                ((1 in2) (1 l1) (1 2) (1 ido))
 106                                ch-%offset%)
 107                   (* sn
 108                      (+
 109                       (f2cl-lib:fref cc-%data%
 110                                      (1 k 1 1)
 111                                      ((1 in1) (1 l1) (1 ido) (1 2))
 112                                      cc-%offset%)
 113                       (f2cl-lib:fref cc-%data%
 114                                      (1 k 1 2)
 115                                      ((1 in1) (1 l1) (1 ido) (1 2))
 116                                      cc-%offset%))))
 117           (setf (f2cl-lib:fref ch-%data%
 118                                (1 k 2 1)
 119                                ((1 in2) (1 l1) (1 2) (1 ido))
 120                                ch-%offset%)
 121                   (* sn
 122                      (-
 123                       (f2cl-lib:fref cc-%data%
 124                                      (1 k 1 1)
 125                                      ((1 in1) (1 l1) (1 ido) (1 2))
 126                                      cc-%offset%)
 127                       (f2cl-lib:fref cc-%data%
 128                                      (1 k 1 2)
 129                                      ((1 in1) (1 l1) (1 ido) (1 2))
 130                                      cc-%offset%))))
 131           (setf (f2cl-lib:fref ch-%data%
 132                                (2 k 1 1)
 133                                ((1 in2) (1 l1) (1 2) (1 ido))
 134                                ch-%offset%)
 135                   (* sn
 136                      (+
 137                       (f2cl-lib:fref cc-%data%
 138                                      (2 k 1 1)
 139                                      ((1 in1) (1 l1) (1 ido) (1 2))
 140                                      cc-%offset%)
 141                       (f2cl-lib:fref cc-%data%
 142                                      (2 k 1 2)
 143                                      ((1 in1) (1 l1) (1 ido) (1 2))
 144                                      cc-%offset%))))
 145           (setf (f2cl-lib:fref ch-%data%
 146                                (2 k 2 1)
 147                                ((1 in2) (1 l1) (1 2) (1 ido))
 148                                ch-%offset%)
 149                   (* sn
 150                      (-
 151                       (f2cl-lib:fref cc-%data%
 152                                      (2 k 1 1)
 153                                      ((1 in1) (1 l1) (1 ido) (1 2))
 154                                      cc-%offset%)
 155                       (f2cl-lib:fref cc-%data%
 156                                      (2 k 1 2)
 157                                      ((1 in1) (1 l1) (1 ido) (1 2))
 158                                      cc-%offset%))))
 159          label107))
 160       (go end_label)
 161      label102
 162       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 163                     ((> k l1) nil)
 164         (tagbody
 165           (setf (f2cl-lib:fref ch-%data%
 166                                (1 k 1 1)
 167                                ((1 in2) (1 l1) (1 2) (1 ido))
 168                                ch-%offset%)
 169                   (+
 170                    (f2cl-lib:fref cc-%data%
 171                                   (1 k 1 1)
 172                                   ((1 in1) (1 l1) (1 ido) (1 2))
 173                                   cc-%offset%)
 174                    (f2cl-lib:fref cc-%data%
 175                                   (1 k 1 2)
 176                                   ((1 in1) (1 l1) (1 ido) (1 2))
 177                                   cc-%offset%)))
 178           (setf (f2cl-lib:fref ch-%data%
 179                                (1 k 2 1)
 180                                ((1 in2) (1 l1) (1 2) (1 ido))
 181                                ch-%offset%)
 182                   (-
 183                    (f2cl-lib:fref cc-%data%
 184                                   (1 k 1 1)
 185                                   ((1 in1) (1 l1) (1 ido) (1 2))
 186                                   cc-%offset%)
 187                    (f2cl-lib:fref cc-%data%
 188                                   (1 k 1 2)
 189                                   ((1 in1) (1 l1) (1 ido) (1 2))
 190                                   cc-%offset%)))
 191           (setf (f2cl-lib:fref ch-%data%
 192                                (2 k 1 1)
 193                                ((1 in2) (1 l1) (1 2) (1 ido))
 194                                ch-%offset%)
 195                   (+
 196                    (f2cl-lib:fref cc-%data%
 197                                   (2 k 1 1)
 198                                   ((1 in1) (1 l1) (1 ido) (1 2))
 199                                   cc-%offset%)
 200                    (f2cl-lib:fref cc-%data%
 201                                   (2 k 1 2)
 202                                   ((1 in1) (1 l1) (1 ido) (1 2))
 203                                   cc-%offset%)))
 204           (setf (f2cl-lib:fref ch-%data%
 205                                (2 k 2 1)
 206                                ((1 in2) (1 l1) (1 2) (1 ido))
 207                                ch-%offset%)
 208                   (-
 209                    (f2cl-lib:fref cc-%data%
 210                                   (2 k 1 1)
 211                                   ((1 in1) (1 l1) (1 ido) (1 2))
 212                                   cc-%offset%)
 213                    (f2cl-lib:fref cc-%data%
 214                                   (2 k 1 2)
 215                                   ((1 in1) (1 l1) (1 ido) (1 2))
 216                                   cc-%offset%)))
 217          label103))
 218       (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1))
 219                     ((> i ido) nil)
 220         (tagbody
 221           (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 222                         ((> k l1) nil)
 223             (tagbody
 224               (setf (f2cl-lib:fref ch-%data%
 225                                    (1 k 1 i)
 226                                    ((1 in2) (1 l1) (1 2) (1 ido))
 227                                    ch-%offset%)
 228                       (+
 229                        (f2cl-lib:fref cc-%data%
 230                                       (1 k i 1)
 231                                       ((1 in1) (1 l1) (1 ido) (1 2))
 232                                       cc-%offset%)
 233                        (f2cl-lib:fref cc-%data%
 234                                       (1 k i 2)
 235                                       ((1 in1) (1 l1) (1 ido) (1 2))
 236                                       cc-%offset%)))
 237               (setf tr2
 238                       (-
 239                        (f2cl-lib:fref cc-%data%
 240                                       (1 k i 1)
 241                                       ((1 in1) (1 l1) (1 ido) (1 2))
 242                                       cc-%offset%)
 243                        (f2cl-lib:fref cc-%data%
 244                                       (1 k i 2)
 245                                       ((1 in1) (1 l1) (1 ido) (1 2))
 246                                       cc-%offset%)))
 247               (setf (f2cl-lib:fref ch-%data%
 248                                    (2 k 1 i)
 249                                    ((1 in2) (1 l1) (1 2) (1 ido))
 250                                    ch-%offset%)
 251                       (+
 252                        (f2cl-lib:fref cc-%data%
 253                                       (2 k i 1)
 254                                       ((1 in1) (1 l1) (1 ido) (1 2))
 255                                       cc-%offset%)
 256                        (f2cl-lib:fref cc-%data%
 257                                       (2 k i 2)
 258                                       ((1 in1) (1 l1) (1 ido) (1 2))
 259                                       cc-%offset%)))
 260               (setf ti2
 261                       (-
 262                        (f2cl-lib:fref cc-%data%
 263                                       (2 k i 1)
 264                                       ((1 in1) (1 l1) (1 ido) (1 2))
 265                                       cc-%offset%)
 266                        (f2cl-lib:fref cc-%data%
 267                                       (2 k i 2)
 268                                       ((1 in1) (1 l1) (1 ido) (1 2))
 269                                       cc-%offset%)))
 270               (setf (f2cl-lib:fref ch-%data%
 271                                    (2 k 2 i)
 272                                    ((1 in2) (1 l1) (1 2) (1 ido))
 273                                    ch-%offset%)
 274                       (-
 275                        (*
 276                         (f2cl-lib:fref wa-%data%
 277                                        (i 1 1)
 278                                        ((1 ido) (1 1) (1 2))
 279                                        wa-%offset%)
 280                         ti2)
 281                        (*
 282                         (f2cl-lib:fref wa-%data%
 283                                        (i 1 2)
 284                                        ((1 ido) (1 1) (1 2))
 285                                        wa-%offset%)
 286                         tr2)))
 287               (setf (f2cl-lib:fref ch-%data%
 288                                    (1 k 2 i)
 289                                    ((1 in2) (1 l1) (1 2) (1 ido))
 290                                    ch-%offset%)
 291                       (+
 292                        (*
 293                         (f2cl-lib:fref wa-%data%
 294                                        (i 1 1)
 295                                        ((1 ido) (1 1) (1 2))
 296                                        wa-%offset%)
 297                         tr2)
 298                        (*
 299                         (f2cl-lib:fref wa-%data%
 300                                        (i 1 2)
 301                                        ((1 ido) (1 1) (1 2))
 302                                        wa-%offset%)
 303                         ti2)))
 304              label104))
 305          label105))
 306       (go end_label)
 307      end_label
 308       (return (values nil nil nil nil nil nil nil nil)))))
 309
 310 (in-package #:cl-user)
 311 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 312 (eval-when (:load-toplevel :compile-toplevel :execute)
 313   (setf (gethash 'fortran-to-lisp::c1f2kf
 314                  fortran-to-lisp::*f2cl-function-info*)
 315           (fortran-to-lisp::make-f2cl-finfo
 316            :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 317                         (fortran-to-lisp::integer4) (array double-float (*))
 318                         (fortran-to-lisp::integer4) (array double-float (*))
 319                         (fortran-to-lisp::integer4) (array double-float (*)))
 320            :return-values '(nil nil nil nil nil nil nil nil)
 321            :calls 'nil)))
 322