(require "f2cl_macros")

(defun vander (x w q n &key (nmax 100) (zero 0.0) (one 1.0))
 (declare (type (simple-array double-float (*)) x))
 (declare (type (simple-array double-float (*)) w))
 (declare (type (simple-array double-float (*)) q)) (declare (type fixnum n))
 (declare (type fixnum nmax)) (declare (type double-float zero))
 (declare (type double-float one))
 (prog
  ((c (make-array nmax :element-type 'double-float)) (k1 0) (k 0) (s 0.0d0)
   (b 0.0d0) (t_ 0.0d0) (j 0) (xx 0.0d0) (i 0)
  )
  (declare (type (simple-array double-float (*)) c)) (declare (type fixnum k1))
  (declare (type fixnum k)) (declare (type double-float s))
  (declare (type double-float b)) (declare (type double-float t_))
  (declare (type fixnum j)) (declare (type double-float xx))
  (declare (type fixnum i))
  (cond ((= n 1) (fset (fref w 1) (fref q 1)))
   (t (fdo ((i 1 (+ i 1))) ((> i n) nil) (tagbody (fset (fref c i) zero)))
    (fset (fref c n) (- (fref x 1)))
    (fdo ((i 2 (+ i 1))) ((> i n) nil)
     (tagbody (setf xx (- (fref x i)))
      (fdo ((j (+ (+ n 1) (- i)) (+ j 1))) ((> j (+ n (- 1))) nil)
       (tagbody (fset (fref c j) (+ (fref c j) (* xx (fref c (+ j 1))))))
      )
      (fset (fref c n) (+ (fref c n) xx))
    ))
    (fdo ((i 1 (+ i 1))) ((> i n) nil)
     (tagbody (setf xx (fref x i)) (setf t_ one) (setf b one)
      (setf s (fref q n)) (setf k n)
      (fdo ((j 2 (+ j 1))) ((> j n) nil)
       (tagbody (setf k1 (+ k (- 1))) (setf b (+ (fref c k) (* xx b)))
        (setf s (+ s (* (fref q k1) b))) (setf t_ (+ (* xx t_) b)) (setf k k1)
      ))
      (fset (fref w i) (/ s t_))
  ))))
  (return (values x w q n))
))