(defun kurvp2 (t_ xs ys n x y xp yp s sigma) (declare (type float t_)) (declare (type float xs)) (declare (type float ys)) (declare (type fixnum n)) (declare (type (simple-array float (*)) x)) (declare (type (simple-array float (*)) y)) (declare (type (simple-array float (*)) xp)) (declare (type (simple-array float (*)) yp)) (declare (type (simple-array float (*)) s)) (declare (type float sigma)) (prog ((sinhp1 0.0d0) (coshp2 0.0d0) (sinhm2 0.0d0) (cim1 0.0d0) (sinhp2 0.0d0) (coshp1 0.0d0) (sinhm1 0.0d0) (ci 0.0d0) (sinhms 0.0d0) (delp2 0.0d0) (delp1 0.0d0) (c2 0.0d0) (c1 0.0d0) (d 0.0d0) (sumy 0.0d0) (sumx 0.0d0) (dels 0.0d0) (del2 0.0d0) (del1 0.0d0) (si 0.0d0) (sigmap 0.0d0) (i 0) (im1 0) (tn 0.0d0) ) (declare (type double-float sinhp1)) (declare (type double-float coshp2)) (declare (type double-float sinhm2)) (declare (type double-float cim1)) (declare (type double-float sinhp2)) (declare (type double-float coshp1)) (declare (type double-float sinhm1)) (declare (type double-float ci)) (declare (type double-float sinhms)) (declare (type double-float delp2)) (declare (type double-float delp1)) (declare (type double-float c2)) (declare (type double-float c1)) (declare (type double-float d)) (declare (type double-float sumy)) (declare (type double-float sumx)) (declare (type double-float dels)) (declare (type double-float del2)) (declare (type double-float del1)) (declare (type double-float si)) (declare (type double-float sigmap)) (declare (type fixnum i)) (declare (type fixnum im1)) (declare (type double-float tn)) (setf tn (+ t_ (- (float (ifix t_))))) (if (< tn 0.0) (setf tn (+ tn 1.0))) (setf tn (+ (* (fref s n) tn) (fref s 1))) (setf im1 n) (if (< tn (fref s n)) (setf im1 (intrvl tn s n))) (setf i (+ im1 1)) (if (> i n) (setf i 1)) (setf sigmap (/ (* (abs sigma) (float n)) (fref s n))) (setf si (fref s i)) (if (= im1 n) (setf si (+ (fref s n) (fref s 1)))) (setf del1 (+ tn (- (fref s im1)))) (setf del2 (+ si (- tn))) (setf dels (+ si (- (fref s im1)))) (setf sumx (/ (+ (* (fref x i) del1) (* (fref x im1) del2)) dels)) (setf sumy (/ (+ (* (fref y i) del1) (* (fref y im1) del2)) dels)) (if (/= sigmap 0.0) (go label1)) (setf d (/ (* del1 del2) (* 6.0 dels))) (setf c1 (* (+ del1 dels) d)) (setf c2 (* (+ del2 dels) d)) (setf xs (+ (+ sumx (* (* -1 (fref xp i)) c1)) (* (* -1 (fref xp im1)) c2))) (setf ys (+ (+ sumy (* (* -1 (fref yp i)) c1)) (* (* -1 (fref yp im1)) c2))) (go end_label) label1 (setf delp1 (/ (* sigmap (+ del1 dels)) 2.0)) (setf delp2 (/ (* sigmap (+ del2 dels)) 2.0)) (multiple-value-setq (sinhm1 dummy dummy_var dummy_var) (snhcsh sinhm1 dummy (* sigmap del1) (- 1)) ) (multiple-value-setq (sinhm2 dummy dummy_var dummy_var) (snhcsh sinhm2 dummy (* sigmap del2) (- 1)) ) (multiple-value-setq (sinhms dummy dummy_var dummy_var) (snhcsh sinhms dummy (* sigmap dels) (- 1)) ) (multiple-value-setq (sinhp1 dummy dummy_var dummy_var) (snhcsh sinhp1 dummy (/ (* sigmap del1) 2.0) (- 1)) ) (multiple-value-setq (sinhp2 dummy dummy_var dummy_var) (snhcsh sinhp2 dummy (/ (* sigmap del2) 2.0) (- 1)) ) (multiple-value-setq (dummy coshp1 delp1 dummy_var) (snhcsh dummy coshp1 delp1 1) ) (multiple-value-setq (dummy coshp2 delp2 dummy_var) (snhcsh dummy coshp2 delp2 1) ) (setf d (* (* (* sigmap sigmap) dels) (+ sinhms (* sigmap dels)))) (setf ci (/ (+ (* sinhm1 del2) (* (* -1 del1) (+ (* (* 2.0 (+ coshp1 1.0)) sinhp2) (* (* sigmap coshp1) del2)) )) d )) (setf cim1 (/ (+ (* sinhm2 del1) (* (* -1 del2) (+ (* (* 2.0 (+ coshp2 1.0)) sinhp1) (* (* sigmap coshp2) del1)) )) d )) (setf xs (+ (+ sumx (* ci (fref xp i))) (* cim1 (fref xp im1)))) (setf ys (+ (+ sumy (* ci (fref yp i))) (* cim1 (fref yp im1)))) (go end_label) end_label (return (values t xs ys n x y xp yp s sigma)) ))