(proclaim
 '(special npardm kntdim nbreak edist level smooth degree dbreak bright bleft
   xbreak charf norm accur b a knots error buffer discrd right nstack npar
   maxstk maxpar maxknt maxaux left interp ibreak factor both break xright
   xleft errori dsctol rightx nintrp leftx xintrp xdd fright fleft fintrp
   ddtemp
) )
(declare (type fixnum npardm))
(declare (type fixnum kntdim))
(declare (type fixnum nbreak))
(declare (type fixnum edist))
(declare (type fixnum level))
(declare (type fixnum smooth))
(declare (type fixnum degree))
(declare (type (simple-array double-float (20)) dbreak))
(declare (type (simple-array double-float (20)) bright))
(declare (type (simple-array double-float (20)) bleft))
(declare (type (simple-array double-float (20)) xbreak))
(declare (type double-float charf))
(declare (type double-float norm))
(declare (type double-float accur))
(declare (type double-float b))
(declare (type double-float a))
(declare (type fixnum knots))
(declare (type double-float error))
(declare (type double-float buffer))
(declare (type t discrd))
(declare (type fixnum right))
(declare (type fixnum nstack))
(declare (type fixnum npar))
(declare (type fixnum maxstk))
(declare (type fixnum maxpar))
(declare (type fixnum maxknt))
(declare (type fixnum maxaux))
(declare (type fixnum left))
(declare (type fixnum interp))
(declare (type fixnum ibreak))
(declare (type (simple-array double-float (20)) factor))
(declare (type fixnum both))
(declare (type fixnum break))
(declare (type (simple-array double-float (50)) xright))
(declare (type (simple-array double-float (50)) xleft))
(declare (type double-float errori))
(declare (type double-float dsctol))
(declare (type fixnum rightx))
(declare (type fixnum nintrp))
(declare (type fixnum leftx))
(declare (type (simple-array double-float (18)) xintrp))
(declare (type (simple-array double-float (20)) xdd))
(declare (type (simple-array double-float (10)) fright))
(declare (type (simple-array double-float (10)) fleft))
(declare (type (simple-array double-float (18)) fintrp))
(declare (type (simple-array double-float (20 20)) ddtemp))

(defun adtran (d powers) (declare (type (simple-array double-float (20 *)) d))
 (declare (type (simple-array double-float (*)) powers))
 (prog
  ((shift 0.0d0) (xl 0.0d0) (xr 0.0d0)
   (xtemp (make-array '(20) :element-type 'double-float)) (koef 0) (khi 0)
   (j 0) (ltop 0) (l 0) (i 0) (ii 0) (nrlk 0) (k 0) (ni1 0) (nrli 0) (nri1 0)
   (nri 0) (nrl 0) (ni 0) (nr 0) (nl 0)
  )
  (declare (type double-float shift)) (declare (type double-float xl))
  (declare (type double-float xr))
  (declare (type (simple-array double-float (*)) xtemp))
  (declare (type fixnum koef)) (declare (type fixnum khi))
  (declare (type fixnum j)) (declare (type fixnum ltop))
  (declare (type fixnum l)) (declare (type fixnum i))
  (declare (type fixnum ii)) (declare (type fixnum nrlk))
  (declare (type fixnum k)) (declare (type fixnum ni1))
  (declare (type fixnum nrli)) (declare (type fixnum nri1))
  (declare (type fixnum nri)) (declare (type fixnum nrl))
  (declare (type fixnum ni)) (declare (type fixnum nr))
  (declare (type fixnum nl)) (setf xl (fref xleft nstack))
  (setf xr (fref xright nstack)) (setf nl leftx) (setf nr rightx)
  (setf ni nintrp) (setf nrl (+ nr nl)) (setf nri (+ nr ni))
  (setf nri1 (+ nri (- 1))) (setf nrli (+ nrl ni)) (if (= ni 0) (go label100))
  (if (= ni 1) (go label10)) (if (= ni 2) (go label20)) (go label30) label10
  (fset (fref powers 1) (fref d (+ nrl 1) 1)) (go label80) label20
  (fset (fref powers 1)
   (+ (fref d (+ nrl 1) 1) (* (+ xr (- (fref xintrp 1))) (fref d (+ nrl 2) 1)))
  )
  (fset (fref powers 2) (fref d (+ nrl 2) 1)) (go label80) label30
  (setf ni1 (+ ni (- 1)))
  (fdo ((k 1 (+ k 1))) ((> k ni) nil)
   (tagbody (fset (fref xtemp k) (fref xintrp k)) (setf nrlk (+ nrl k))
    (fset (fref powers k) (fref d nrlk 1))
  ))
  (fdo ((k 1 (+ k 1))) ((> k ni1) nil)
   (tagbody
    (fdo ((ii 1 (+ ii 1))) ((> ii ni1) nil)
     (tagbody (setf i (+ ni (- ii)))
      (fset (fref powers i)
       (+ (fref powers i) (* (+ xr (- (fref xtemp i))) (fref powers (+ i 1))))
    )))
    (fdo ((ii 1 (+ ii 1))) ((> ii ni1) nil)
     (tagbody (setf i (+ ni (- ii))) (fset (fref xtemp (+ i 1)) (fref xtemp i))
    ))
    (fset (fref xtemp 1) xr)
  ))
  label80
  (fdo ((k 1 (+ k 1))) ((> k ni) nil)
   (tagbody (setf l (+ (+ ni 1) (- k))) (setf ltop (+ l nrl))
    (fset (fref powers ltop) (fref powers l))
  ))
  label100
  (fdo ((j 1 (+ j 1))) ((> j nrl) nil)
   (tagbody (fset (fref powers j) (fref d j 1)))
  )
  (if (= nri 1) (go label140)) (setf shift (+ xr (- xl))) (setf khi nri1)
  (fdo ((j 2 (+ j 1))) ((> j nri) nil)
   (tagbody
    (fdo ((k 1 (+ k 1))) ((> k khi) nil)
     (tagbody (setf koef (+ nrli (- k)))
      (fset (fref powers koef)
       (+ (fref powers koef) (* (* -1 shift) (fref powers (+ koef 1))))
    )))
    (setf khi (+ khi (- 1)))
  ))
  label140 (return (values d powers))
))