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