(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 adapt
 (f xlft xrgt epsln npiece errest xknots coefs ierr kmax ndeg nsmth anorm dx mo
  kbreak brakpt kdiff vallft valrgt
 )
 (declare (type double-float xlft)) (declare (type double-float xrgt))
 (declare (type double-float epsln)) (declare (type fixnum npiece))
 (declare (type double-float errest))
 (declare (type (simple-array double-float (*)) xknots))
 (declare (type (simple-array double-float (* *)) coefs))
 (declare (type fixnum ierr)) (declare (type fixnum kmax))
 (declare (type fixnum ndeg)) (declare (type fixnum nsmth))
 (declare (type double-float anorm)) (declare (type double-float dx))
 (declare (type fixnum mo)) (declare (type fixnum kbreak))
 (declare (type (simple-array double-float (*)) brakpt))
 (declare (type (simple-array fixnum (*)) kdiff))
 (declare (type (simple-array double-float (*)) vallft))
 (declare (type (simple-array double-float (*)) valrgt))
 (prog ((f 0.0d0) (ndimen 0) (kdimen 0) (k 0)) (declare (type double-float f))
  (declare (type fixnum ndimen)) (declare (type fixnum kdimen))
  (declare (type fixnum k)) (setf a xlft) (setf b xrgt) (setf accur epsln)
  (setf degree ndeg) (setf smooth nsmth) (setf norm anorm) (setf charf dx)
  (setf edist mo) (setf nbreak kbreak)
  (if (or (<= nbreak 0) (>= nbreak 21)) (go label30))
  (fdo ((k 1 (+ k 1))) ((> k nbreak) nil)
   (tagbody (fset (fref xbreak k) (fref brakpt k))
    (fset (fref dbreak k) (fref kdiff k)) (fset (fref bleft k) (fref vallft k))
    (fset (fref bright k) (fref valrgt k))
  ))
  label30 (setf kdimen (+ kmax 1)) (setf ndimen (+ ndeg 1))
  (multiple-value-setq (f xknots coefs kdimen kmax ndimen ierr)
   (adapt1 f xknots coefs kdimen kmax ndimen ierr)
  )
  (setf npiece knots) (setf errest error)
  (return
   (values f xlft xrgt epsln npiece errest xknots coefs ierr kmax ndeg nsmth
    anorm dx mo kbreak brakpt kdiff vallft valrgt
))))