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