1;;; Compiled by f2cl version:
2;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $"
3;;;  "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $"
4;;;  "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $"
5;;;  "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $"
6;;;  "f2cl5.l,v 1.204 2010/02/23 05:21:30 rtoy Exp $"
7;;;  "f2cl6.l,v 1.48 2008/08/24 00:56:27 rtoy Exp $"
8;;;  "macros.l,v 1.114 2010/05/17 01:42:14 rtoy Exp $")
9
10;;; Using Lisp CMU Common Lisp CVS Head 2010-05-25 18:21:07 (20A 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 double-float))
16
17(in-package :colnew)
18
19
20(defun vmonde (rho coef k)
21  (declare (type (f2cl-lib:integer4) k)
22           (type (array double-float (*)) coef rho))
23  (f2cl-lib:with-multi-array-data
24      ((rho double-float rho-%data% rho-%offset%)
25       (coef double-float coef-%data% coef-%offset%))
26    (prog ((i 0) (ifac 0) (j 0) (km1 0) (kmi 0))
27      (declare (type (f2cl-lib:integer4) kmi km1 j ifac i))
28      (if (= k 1) (go end_label))
29      (setf km1 (f2cl-lib:int-sub k 1))
30      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
31                    ((> i km1) nil)
32        (tagbody
33          (setf kmi (f2cl-lib:int-sub k i))
34          (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
35                        ((> j kmi) nil)
36            (tagbody
37              (setf (f2cl-lib:fref coef-%data% (j) ((1 k)) coef-%offset%)
38                      (/
39                       (-
40                        (f2cl-lib:fref coef-%data%
41                                       ((f2cl-lib:int-add j 1))
42                                       ((1 k))
43                                       coef-%offset%)
44                        (f2cl-lib:fref coef-%data% (j) ((1 k)) coef-%offset%))
45                       (-
46                        (f2cl-lib:fref rho-%data%
47                                       ((f2cl-lib:int-add j i))
48                                       ((1 k))
49                                       rho-%offset%)
50                        (f2cl-lib:fref rho-%data% (j) ((1 k)) rho-%offset%))))
51             label10))))
52     label10
53      (setf ifac 1)
54      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
55                    ((> i km1) nil)
56        (tagbody
57          (setf kmi (f2cl-lib:int-sub (f2cl-lib:int-add k 1) i))
58          (f2cl-lib:fdo (j 2 (f2cl-lib:int-add j 1))
59                        ((> j kmi) nil)
60            (tagbody
61             label30
62              (setf (f2cl-lib:fref coef-%data% (j) ((1 k)) coef-%offset%)
63                      (- (f2cl-lib:fref coef-%data% (j) ((1 k)) coef-%offset%)
64                         (*
65                          (f2cl-lib:fref rho-%data%
66                                         ((f2cl-lib:int-sub
67                                           (f2cl-lib:int-add j i)
68                                           1))
69                                         ((1 k))
70                                         rho-%offset%)
71                          (f2cl-lib:fref coef-%data%
72                                         ((f2cl-lib:int-sub j 1))
73                                         ((1 k))
74                                         coef-%offset%))))))
75          (setf (f2cl-lib:fref coef-%data% (kmi) ((1 k)) coef-%offset%)
76                  (* (f2cl-lib:dfloat ifac)
77                     (f2cl-lib:fref coef-%data% (kmi) ((1 k)) coef-%offset%)))
78          (setf ifac (f2cl-lib:int-mul ifac i))
79         label40))
80      (setf (f2cl-lib:fref coef-%data% (1) ((1 k)) coef-%offset%)
81              (* (f2cl-lib:dfloat ifac)
82                 (f2cl-lib:fref coef-%data% (1) ((1 k)) coef-%offset%)))
83      (go end_label)
84     end_label
85      (return (values nil nil nil)))))
86
87(in-package #-gcl #:cl-user #+gcl "CL-USER")
88#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
89(eval-when (:load-toplevel :compile-toplevel :execute)
90  (setf (gethash 'fortran-to-lisp::vmonde
91                 fortran-to-lisp::*f2cl-function-info*)
92          (fortran-to-lisp::make-f2cl-finfo
93           :arg-types '((array double-float (*)) (array double-float (*))
94                        (fortran-to-lisp::integer4))
95           :return-values '(nil nil nil)
96           :calls 'nil)))
97
98