share/fftpack5/lisp/mradb3.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 mradb3 (m ido l1 cc im1 in1 ch im2 in2 wa1 wa2)
  21   (declare (type (array double-float (*)) wa2 wa1 ch cc)
  22            (type (f2cl-lib:integer4) in2 im2 in1 im1 l1 ido m))
  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        (wa2 double-float wa2-%data% wa2-%offset%))
  28     (prog ((ic 0) (i 0) (idp2 0) (m1 0) (m2 0) (k 0) (taui 0.0d0) (taur 0.0d0)
  29            (arg 0.0d0) (m2s 0) (m1d 0))
  30       (declare (type (double-float) arg taur taui)
  31                (type (f2cl-lib:integer4) m1d m2s k m2 m1 idp2 i ic))
  32       (setf m1d
  33               (f2cl-lib:int-add (f2cl-lib:int-mul (f2cl-lib:int-sub m 1) im1)
  34                                 1))
  35       (setf m2s (f2cl-lib:int-sub 1 im2))
  36       (setf arg (/ (* 2.0d0 4.0d0 (atan 1.0d0)) 3.0d0))
  37       (setf taur (cos arg))
  38       (setf taui (sin arg))
  39       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
  40                     ((> k l1) nil)
  41         (tagbody
  42           (setf m2 m2s)
  43           (f2cl-lib:fdo (m1 1 (f2cl-lib:int-add m1 im1))
  44                         ((> m1 m1d) nil)
  45             (tagbody
  46               (setf m2 (f2cl-lib:int-add m2 im2))
  47               (setf (f2cl-lib:fref ch-%data%
  48                                    (m2 1 k 1)
  49                                    ((1 in2) (1 ido) (1 l1) (1 3))
  50                                    ch-%offset%)
  51                       (+
  52                        (f2cl-lib:fref cc-%data%
  53                                       (m1 1 1 k)
  54                                       ((1 in1) (1 ido) (1 3) (1 l1))
  55                                       cc-%offset%)
  56                        (* 2.0d0
  57                           (f2cl-lib:fref cc-%data%
  58                                          (m1 ido 2 k)
  59                                          ((1 in1) (1 ido) (1 3) (1 l1))
  60                                          cc-%offset%))))
  61               (setf (f2cl-lib:fref ch-%data%
  62                                    (m2 1 k 2)
  63                                    ((1 in2) (1 ido) (1 l1) (1 3))
  64                                    ch-%offset%)
  65                       (-
  66                        (+
  67                         (f2cl-lib:fref cc-%data%
  68                                        (m1 1 1 k)
  69                                        ((1 in1) (1 ido) (1 3) (1 l1))
  70                                        cc-%offset%)
  71                         (* 2.0d0
  72                            taur
  73                            (f2cl-lib:fref cc-%data%
  74                                           (m1 ido 2 k)
  75                                           ((1 in1) (1 ido) (1 3) (1 l1))
  76                                           cc-%offset%)))
  77                        (* 2.0d0
  78                           taui
  79                           (f2cl-lib:fref cc-%data%
  80                                          (m1 1 3 k)
  81                                          ((1 in1) (1 ido) (1 3) (1 l1))
  82                                          cc-%offset%))))
  83               (setf (f2cl-lib:fref ch-%data%
  84                                    (m2 1 k 3)
  85                                    ((1 in2) (1 ido) (1 l1) (1 3))
  86                                    ch-%offset%)
  87                       (+
  88                        (f2cl-lib:fref cc-%data%
  89                                       (m1 1 1 k)
  90                                       ((1 in1) (1 ido) (1 3) (1 l1))
  91                                       cc-%offset%)
  92                        (* 2.0d0
  93                           taur
  94                           (f2cl-lib:fref cc-%data%
  95                                          (m1 ido 2 k)
  96                                          ((1 in1) (1 ido) (1 3) (1 l1))
  97                                          cc-%offset%))
  98                        (* 2.0d0
  99                           taui
 100                           (f2cl-lib:fref cc-%data%
 101                                          (m1 1 3 k)
 102                                          ((1 in1) (1 ido) (1 3) (1 l1))
 103                                          cc-%offset%))))
 104              label1001))
 105          label101))
 106       (if (= ido 1) (go end_label))
 107       (setf idp2 (f2cl-lib:int-add ido 2))
 108       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 109                     ((> k l1) nil)
 110         (tagbody
 111           (f2cl-lib:fdo (i 3 (f2cl-lib:int-add i 2))
 112                         ((> i ido) nil)
 113             (tagbody
 114               (setf ic (f2cl-lib:int-sub idp2 i))
 115               (setf m2 m2s)
 116               (f2cl-lib:fdo (m1 1 (f2cl-lib:int-add m1 im1))
 117                             ((> m1 m1d) nil)
 118                 (tagbody
 119                   (setf m2 (f2cl-lib:int-add m2 im2))
 120                   (setf (f2cl-lib:fref ch-%data%
 121                                        (m2 (f2cl-lib:int-sub i 1) k 1)
 122                                        ((1 in2) (1 ido) (1 l1) (1 3))
 123                                        ch-%offset%)
 124                           (+
 125                            (f2cl-lib:fref cc-%data%
 126                                           (m1 (f2cl-lib:int-sub i 1) 1 k)
 127                                           ((1 in1) (1 ido) (1 3) (1 l1))
 128                                           cc-%offset%)
 129                            (+
 130                             (f2cl-lib:fref cc-%data%
 131                                            (m1 (f2cl-lib:int-sub i 1) 3 k)
 132                                            ((1 in1) (1 ido) (1 3) (1 l1))
 133                                            cc-%offset%)
 134                             (f2cl-lib:fref cc-%data%
 135                                            (m1 (f2cl-lib:int-sub ic 1) 2 k)
 136                                            ((1 in1) (1 ido) (1 3) (1 l1))
 137                                            cc-%offset%))))
 138                   (setf (f2cl-lib:fref ch-%data%
 139                                        (m2 i k 1)
 140                                        ((1 in2) (1 ido) (1 l1) (1 3))
 141                                        ch-%offset%)
 142                           (+
 143                            (f2cl-lib:fref cc-%data%
 144                                           (m1 i 1 k)
 145                                           ((1 in1) (1 ido) (1 3) (1 l1))
 146                                           cc-%offset%)
 147                            (-
 148                             (f2cl-lib:fref cc-%data%
 149                                            (m1 i 3 k)
 150                                            ((1 in1) (1 ido) (1 3) (1 l1))
 151                                            cc-%offset%)
 152                             (f2cl-lib:fref cc-%data%
 153                                            (m1 ic 2 k)
 154                                            ((1 in1) (1 ido) (1 3) (1 l1))
 155                                            cc-%offset%))))
 156                   (setf (f2cl-lib:fref ch-%data%
 157                                        (m2 (f2cl-lib:int-sub i 1) k 2)
 158                                        ((1 in2) (1 ido) (1 l1) (1 3))
 159                                        ch-%offset%)
 160                           (-
 161                            (*
 162                             (f2cl-lib:fref wa1-%data%
 163                                            ((f2cl-lib:int-sub i 2))
 164                                            ((1 ido))
 165                                            wa1-%offset%)
 166                             (-
 167                              (+
 168                               (f2cl-lib:fref cc-%data%
 169                                              (m1 (f2cl-lib:int-sub i 1) 1 k)
 170                                              ((1 in1) (1 ido) (1 3) (1 l1))
 171                                              cc-%offset%)
 172                               (* taur
 173                                  (+
 174                                   (f2cl-lib:fref cc-%data%
 175                                                  (m1 (f2cl-lib:int-sub i 1) 3
 176                                                   k)
 177                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 178                                                  cc-%offset%)
 179                                   (f2cl-lib:fref cc-%data%
 180                                                  (m1 (f2cl-lib:int-sub ic 1) 2
 181                                                   k)
 182                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 183                                                  cc-%offset%))))
 184                              (* taui
 185                                 (+
 186                                  (f2cl-lib:fref cc-%data%
 187                                                 (m1 i 3 k)
 188                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 189                                                 cc-%offset%)
 190                                  (f2cl-lib:fref cc-%data%
 191                                                 (m1 ic 2 k)
 192                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 193                                                 cc-%offset%)))))
 194                            (*
 195                             (f2cl-lib:fref wa1-%data%
 196                                            ((f2cl-lib:int-sub i 1))
 197                                            ((1 ido))
 198                                            wa1-%offset%)
 199                             (+
 200                              (f2cl-lib:fref cc-%data%
 201                                             (m1 i 1 k)
 202                                             ((1 in1) (1 ido) (1 3) (1 l1))
 203                                             cc-%offset%)
 204                              (* taur
 205                                 (-
 206                                  (f2cl-lib:fref cc-%data%
 207                                                 (m1 i 3 k)
 208                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 209                                                 cc-%offset%)
 210                                  (f2cl-lib:fref cc-%data%
 211                                                 (m1 ic 2 k)
 212                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 213                                                 cc-%offset%)))
 214                              (* taui
 215                                 (-
 216                                  (f2cl-lib:fref cc-%data%
 217                                                 (m1 (f2cl-lib:int-sub i 1) 3 k)
 218                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 219                                                 cc-%offset%)
 220                                  (f2cl-lib:fref cc-%data%
 221                                                 (m1 (f2cl-lib:int-sub ic 1) 2
 222                                                  k)
 223                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 224                                                 cc-%offset%)))))))
 225                   (setf (f2cl-lib:fref ch-%data%
 226                                        (m2 i k 2)
 227                                        ((1 in2) (1 ido) (1 l1) (1 3))
 228                                        ch-%offset%)
 229                           (+
 230                            (*
 231                             (f2cl-lib:fref wa1-%data%
 232                                            ((f2cl-lib:int-sub i 2))
 233                                            ((1 ido))
 234                                            wa1-%offset%)
 235                             (+
 236                              (f2cl-lib:fref cc-%data%
 237                                             (m1 i 1 k)
 238                                             ((1 in1) (1 ido) (1 3) (1 l1))
 239                                             cc-%offset%)
 240                              (* taur
 241                                 (-
 242                                  (f2cl-lib:fref cc-%data%
 243                                                 (m1 i 3 k)
 244                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 245                                                 cc-%offset%)
 246                                  (f2cl-lib:fref cc-%data%
 247                                                 (m1 ic 2 k)
 248                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 249                                                 cc-%offset%)))
 250                              (* taui
 251                                 (-
 252                                  (f2cl-lib:fref cc-%data%
 253                                                 (m1 (f2cl-lib:int-sub i 1) 3 k)
 254                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 255                                                 cc-%offset%)
 256                                  (f2cl-lib:fref cc-%data%
 257                                                 (m1 (f2cl-lib:int-sub ic 1) 2
 258                                                  k)
 259                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 260                                                 cc-%offset%)))))
 261                            (*
 262                             (f2cl-lib:fref wa1-%data%
 263                                            ((f2cl-lib:int-sub i 1))
 264                                            ((1 ido))
 265                                            wa1-%offset%)
 266                             (-
 267                              (+
 268                               (f2cl-lib:fref cc-%data%
 269                                              (m1 (f2cl-lib:int-sub i 1) 1 k)
 270                                              ((1 in1) (1 ido) (1 3) (1 l1))
 271                                              cc-%offset%)
 272                               (* taur
 273                                  (+
 274                                   (f2cl-lib:fref cc-%data%
 275                                                  (m1 (f2cl-lib:int-sub i 1) 3
 276                                                   k)
 277                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 278                                                  cc-%offset%)
 279                                   (f2cl-lib:fref cc-%data%
 280                                                  (m1 (f2cl-lib:int-sub ic 1) 2
 281                                                   k)
 282                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 283                                                  cc-%offset%))))
 284                              (* taui
 285                                 (+
 286                                  (f2cl-lib:fref cc-%data%
 287                                                 (m1 i 3 k)
 288                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 289                                                 cc-%offset%)
 290                                  (f2cl-lib:fref cc-%data%
 291                                                 (m1 ic 2 k)
 292                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 293                                                 cc-%offset%)))))))
 294                   (setf (f2cl-lib:fref ch-%data%
 295                                        (m2 (f2cl-lib:int-sub i 1) k 3)
 296                                        ((1 in2) (1 ido) (1 l1) (1 3))
 297                                        ch-%offset%)
 298                           (-
 299                            (*
 300                             (f2cl-lib:fref wa2-%data%
 301                                            ((f2cl-lib:int-sub i 2))
 302                                            ((1 ido))
 303                                            wa2-%offset%)
 304                             (+
 305                              (f2cl-lib:fref cc-%data%
 306                                             (m1 (f2cl-lib:int-sub i 1) 1 k)
 307                                             ((1 in1) (1 ido) (1 3) (1 l1))
 308                                             cc-%offset%)
 309                              (* taur
 310                                 (+
 311                                  (f2cl-lib:fref cc-%data%
 312                                                 (m1 (f2cl-lib:int-sub i 1) 3 k)
 313                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 314                                                 cc-%offset%)
 315                                  (f2cl-lib:fref cc-%data%
 316                                                 (m1 (f2cl-lib:int-sub ic 1) 2
 317                                                  k)
 318                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 319                                                 cc-%offset%)))
 320                              (* taui
 321                                 (+
 322                                  (f2cl-lib:fref cc-%data%
 323                                                 (m1 i 3 k)
 324                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 325                                                 cc-%offset%)
 326                                  (f2cl-lib:fref cc-%data%
 327                                                 (m1 ic 2 k)
 328                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 329                                                 cc-%offset%)))))
 330                            (*
 331                             (f2cl-lib:fref wa2-%data%
 332                                            ((f2cl-lib:int-sub i 1))
 333                                            ((1 ido))
 334                                            wa2-%offset%)
 335                             (-
 336                              (+
 337                               (f2cl-lib:fref cc-%data%
 338                                              (m1 i 1 k)
 339                                              ((1 in1) (1 ido) (1 3) (1 l1))
 340                                              cc-%offset%)
 341                               (* taur
 342                                  (-
 343                                   (f2cl-lib:fref cc-%data%
 344                                                  (m1 i 3 k)
 345                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 346                                                  cc-%offset%)
 347                                   (f2cl-lib:fref cc-%data%
 348                                                  (m1 ic 2 k)
 349                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 350                                                  cc-%offset%))))
 351                              (* taui
 352                                 (-
 353                                  (f2cl-lib:fref cc-%data%
 354                                                 (m1 (f2cl-lib:int-sub i 1) 3 k)
 355                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 356                                                 cc-%offset%)
 357                                  (f2cl-lib:fref cc-%data%
 358                                                 (m1 (f2cl-lib:int-sub ic 1) 2
 359                                                  k)
 360                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 361                                                 cc-%offset%)))))))
 362                   (setf (f2cl-lib:fref ch-%data%
 363                                        (m2 i k 3)
 364                                        ((1 in2) (1 ido) (1 l1) (1 3))
 365                                        ch-%offset%)
 366                           (+
 367                            (*
 368                             (f2cl-lib:fref wa2-%data%
 369                                            ((f2cl-lib:int-sub i 2))
 370                                            ((1 ido))
 371                                            wa2-%offset%)
 372                             (-
 373                              (+
 374                               (f2cl-lib:fref cc-%data%
 375                                              (m1 i 1 k)
 376                                              ((1 in1) (1 ido) (1 3) (1 l1))
 377                                              cc-%offset%)
 378                               (* taur
 379                                  (-
 380                                   (f2cl-lib:fref cc-%data%
 381                                                  (m1 i 3 k)
 382                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 383                                                  cc-%offset%)
 384                                   (f2cl-lib:fref cc-%data%
 385                                                  (m1 ic 2 k)
 386                                                  ((1 in1) (1 ido) (1 3) (1 l1))
 387                                                  cc-%offset%))))
 388                              (* taui
 389                                 (-
 390                                  (f2cl-lib:fref cc-%data%
 391                                                 (m1 (f2cl-lib:int-sub i 1) 3 k)
 392                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 393                                                 cc-%offset%)
 394                                  (f2cl-lib:fref cc-%data%
 395                                                 (m1 (f2cl-lib:int-sub ic 1) 2
 396                                                  k)
 397                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 398                                                 cc-%offset%)))))
 399                            (*
 400                             (f2cl-lib:fref wa2-%data%
 401                                            ((f2cl-lib:int-sub i 1))
 402                                            ((1 ido))
 403                                            wa2-%offset%)
 404                             (+
 405                              (f2cl-lib:fref cc-%data%
 406                                             (m1 (f2cl-lib:int-sub i 1) 1 k)
 407                                             ((1 in1) (1 ido) (1 3) (1 l1))
 408                                             cc-%offset%)
 409                              (* taur
 410                                 (+
 411                                  (f2cl-lib:fref cc-%data%
 412                                                 (m1 (f2cl-lib:int-sub i 1) 3 k)
 413                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 414                                                 cc-%offset%)
 415                                  (f2cl-lib:fref cc-%data%
 416                                                 (m1 (f2cl-lib:int-sub ic 1) 2
 417                                                  k)
 418                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 419                                                 cc-%offset%)))
 420                              (* taui
 421                                 (+
 422                                  (f2cl-lib:fref cc-%data%
 423                                                 (m1 i 3 k)
 424                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 425                                                 cc-%offset%)
 426                                  (f2cl-lib:fref cc-%data%
 427                                                 (m1 ic 2 k)
 428                                                 ((1 in1) (1 ido) (1 3) (1 l1))
 429                                                 cc-%offset%)))))))
 430                  label1002))
 431              label102))
 432          label103))
 433       (go end_label)
 434      end_label
 435       (return (values nil nil nil nil nil nil nil nil nil nil nil)))))
 436
 437 (in-package #:cl-user)
 438 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 439 (eval-when (:load-toplevel :compile-toplevel :execute)
 440   (setf (gethash 'fortran-to-lisp::mradb3
 441                  fortran-to-lisp::*f2cl-function-info*)
 442           (fortran-to-lisp::make-f2cl-finfo
 443            :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 444                         (fortran-to-lisp::integer4) (array double-float (*))
 445                         (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 446                         (array double-float (*)) (fortran-to-lisp::integer4)
 447                         (fortran-to-lisp::integer4) (array double-float (*))
 448                         (array double-float (*)))
 449            :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
 450            :calls 'nil)))
 451