(defun hull (x y m bx by k vx vy n) (declare (type (simple-array float (*)) x)) (declare (type (simple-array float (*)) y)) (declare (type fixnum m)) (declare (type (simple-array float (*)) bx)) (declare (type (simple-array float (*)) by)) (declare (type fixnum k)) (declare (type (simple-array float (*)) vx)) (declare (type (simple-array float (*)) vy)) (declare (type fixnum n)) (prog ((ibeg nil) (mm1 0) (lbeg 0) (ii 0) (isav 0) (j0 0) (nn 0) (j 0) (ksav 0) (lsav 0) (dy0 0.0d0) (dx0 0.0d0) (r 0.0d0) (dy 0.0d0) (dx 0.0d0) (k0 0) (h 0.0d0) (xmax 0.0d0) (xmin 0.0d0) (xm 0.0d0) (lmax 0) (i 0) (x1 0.0d0) (lmin 0) (l 0) (ymax 0.0d0) (ymin 0.0d0) (onep 0.0d0) (mp1 0) (eps 0.0d0) ) (declare (type t ibeg)) (declare (type fixnum mm1)) (declare (type fixnum lbeg)) (declare (type fixnum ii)) (declare (type fixnum isav)) (declare (type fixnum j0)) (declare (type fixnum nn)) (declare (type fixnum j)) (declare (type fixnum ksav)) (declare (type fixnum lsav)) (declare (type double-float dy0)) (declare (type double-float dx0)) (declare (type double-float r)) (declare (type double-float dy)) (declare (type double-float dx)) (declare (type fixnum k0)) (declare (type double-float h)) (declare (type double-float xmax)) (declare (type double-float xmin)) (declare (type double-float xm)) (declare (type fixnum lmax)) (declare (type fixnum i)) (declare (type double-float x1)) (declare (type fixnum lmin)) (declare (type fixnum l)) (declare (type double-float ymax)) (declare (type double-float ymin)) (declare (type double-float onep)) (declare (type fixnum mp1)) (declare (type double-float eps)) (setf eps (spmpar 1)) (setf mp1 (+ m 1)) (setf onep (+ 1.0 (* 4.0 eps))) (multiple-value-setq (y x m) (rrsort y x m)) (setf ymin (fref y 1)) (setf ymax (fref y m)) (if (= ymin ymax) (go label500)) (setf l 1) label10 (setf l (+ l 1)) (if (= (fref y l) ymin) (go label10)) (setf lmin l) (setf l (+ l (- 1))) (multiple-value-setq (x y l) (rrsort x y l)) (setf x1 (fref x 1)) (setf i m) label20 (setf i (+ i (- 1))) (if (= (fref y i) ymax) (go label20)) (setf lmax i) (setf i (+ i 1)) (multiple-value-setq (dummy_var dummy_var dummy_var) (rrsort (fref x i) (fref y i) (+ m (- lmax))) ) (setf xm (fref x m)) (setf xmin x1) (setf xmax (fref x l)) (fdo ((i lmin (+ i 1))) ((> i m) nil) (tagbody (if (> (fref x i) xmin) (go label30)) (setf xmin (fref x i)) (return) label30 (if (> (fref x i) xmax) (setf xmax (fref x i))) )) (setf k l) (fdo ((i 1 (+ i 1))) ((> i l) nil) (tagbody (fset (fref bx i) (fref x i)) (fset (fref by i) (fref y i))) ) (setf n 1) (fset (fref vx 1) (fref x 1)) (fset (fref vy 1) (fref y 1)) (if (= l 1) (go label100)) (setf n 2) (fset (fref vx 2) (fref x l)) (fset (fref vy 2) (fref y l)) label100 (setf h (+ xmax (- (fref bx k)))) (if (= h 0.0) (go label150)) (setf k0 k) (setf ibeg true) label110 (setf l (+ l 1)) (if (> l lmax) (setf l m)) (setf h (+ (fref x l) (- (fref bx k)))) (if (<= h 0.0) (go label110)) (setf dx (+ (fref x l) (- (fref bx k0)))) (setf dy (+ (fref y l) (- (fref by k0)))) (if ibeg (go label120)) (setf r (* (/ dx0 dx) dy)) (if (> r (* onep dy0)) (go label130)) (if (> dy0 (* onep r)) (go label120)) (if (and (= dy0 0.0) (> dy 0.0)) (go label140)) (setf k (+ k 1)) (go label121) label120 (setf ibeg false) (setf dx0 dx) (setf dy0 dy) (setf k (+ k0 1)) label121 (fset (fref bx k) (fref x l)) (fset (fref by k) (fref y l)) (setf lsav l) label130 (setf h (+ xmax (- (fref x l)))) (if (> h 0.0) (go label110)) label140 (setf l lsav) (setf n (+ n 1)) (fset (fref vx n) (fref bx k)) (fset (fref vy n) (fref by k)) (go label100) label150 (if (= l m) (go label250)) (setf ksav k) (setf i l) label151 (if (= i lmax) (go label160)) (setf i (+ i 1)) (if (/= (fref x i) xmax) (go label151)) (setf l i) (setf k (+ k 1)) (fset (fref bx k) (fref x i)) (fset (fref by k) (fref y i)) (go label151) label160 (setf xmax (fref x l)) (setf h (+ xmax (- xm))) (if (<= h 0.0) (go label170)) (if (/= l lmax) (go label200)) (if (= k ksav) (go label170)) (setf n (+ n 1)) (fset (fref vx n) (fref bx k)) (fset (fref vy n) (fref by k)) label170 (setf l m) (setf k (+ k 1)) (fset (fref bx k) xm) (fset (fref by k) (fref y m)) (setf n (+ n 1)) (fset (fref vx n) xm) (fset (fref vy n) (fref y m)) (go label250) label200 (setf j mp1) (setf nn mp1) (fset (fref bx mp1) xm) (fset (fref vx mp1) xm) (fset (fref by mp1) (fref y m)) (fset (fref vy mp1) (fref y m)) (setf i (+ lmax 1)) label201 (setf j0 j) (setf ibeg true) label210 (setf i (+ i (- 1))) (setf h (+ (fref x i) (- (fref bx j)))) (if (<= h 0.0) (go label210)) (setf dx (+ (fref x i) (- (fref bx j0)))) (setf dy (abs (+ (fref y i) (- (fref by j0))))) (if ibeg (go label220)) (setf r (* (/ dx0 dx) dy)) (if (> r (* onep dy0)) (go label230)) (if (> dy0 (* onep r)) (go label220)) (if (and (= dy0 0.0) (> dy 0.0)) (go label235)) (setf j (+ j (- 1))) (go label221) label220 (setf ibeg false) (setf dx0 dx) (setf dy0 dy) (setf j (+ j0 (- 1))) label221 (fset (fref bx j) (fref x i)) (fset (fref by j) (fref y i)) (setf isav i) label230 (setf h (+ xmax (- (fref x i)))) (if (> h 0.0) (go label210)) label235 (setf i isav) (setf nn (+ nn (- 1))) (fset (fref vx nn) (fref bx j)) (fset (fref vy nn) (fref by j)) (setf h (+ xmax (- (fref bx j)))) (if (> h 0.0) (go label201)) (if (and (= i l) (= k ksav)) (setf nn (+ nn 1))) (fdo ((ii nn (+ ii 1))) ((> ii mp1) nil) (tagbody (setf n (+ n 1)) (fset (fref vx n) (fref vx ii)) (fset (fref vy n) (fref vy ii)) )) (if (= i l) (setf j (+ j 1))) (fdo ((ii j (+ ii 1))) ((> ii mp1) nil) (tagbody (setf k (+ k 1)) (fset (fref bx k) (fref bx ii)) (fset (fref by k) (fref by ii)) )) (setf l m) label250 (setf lbeg (+ lmax 1)) (if (= lbeg m) (go label260)) (setf mm1 (+ m (- 1))) (fdo ((i lbeg (+ i 1))) ((> i mm1) nil) (tagbody (setf l (+ l (- 1))) (setf k (+ k 1)) (fset (fref bx k) (fref x l)) (fset (fref by k) (fref y l)) )) (setf n (+ n 1)) (fset (fref vx n) (fref bx k)) (fset (fref vy n) (fref by k)) label260 (setf h (+ xmax (- (fref bx k)))) (if (> h 0.0) (go label300)) (setf h (+ (fref bx k) (- xmin))) (if (> h 0.0) (go label301)) (go label370) label300 (setf h (+ (fref bx k) (- xmin))) (if (= h 0.0) (go label350)) label301 (setf k0 k) (setf ibeg true) label310 (setf l (+ l (- 1))) (if (< l lmin) (setf l 1)) (setf h (+ (fref x l) (- (fref bx k)))) (if (>= h 0.0) (go label310)) (setf dx (abs (+ (fref x l) (- (fref bx k0))))) (setf dy (abs (+ (fref y l) (- (fref by k0))))) (if ibeg (go label320)) (setf r (* (/ dx0 dx) dy)) (if (> r (* onep dy0)) (go label330)) (if (> dy0 (* onep r)) (go label320)) (if (and (= dy0 0.0) (> dy 0.0)) (go label340)) (setf k (+ k 1)) (go label321) label320 (setf ibeg false) (setf dx0 dx) (setf dy0 dy) (setf k (+ k0 1)) label321 (fset (fref bx k) (fref x l)) (fset (fref by k) (fref y l)) (setf lsav l) label330 (setf h (+ (fref x l) (- xmin))) (if (> h 0.0) (go label310)) label340 (setf l lsav) (setf n (+ n 1)) (fset (fref vx n) (fref bx k)) (fset (fref vy n) (fref by k)) (go label300) label350 (if (= l 1) (go end_label)) (setf ksav k) (setf i l) label351 (if (= i lmin) (go label360)) (setf i (+ i (- 1))) (if (/= (fref x i) xmin) (go label351)) (setf l i) (setf k (+ k 1)) (fset (fref bx k) (fref x i)) (fset (fref by k) (fref y i)) (go label351) label360 (setf xmin (fref x l)) (setf h (+ x1 (- xmin))) (if (<= h 0.0) (go label370)) (if (/= l lmin) (go label400)) (if (= k ksav) (go label370)) (setf n (+ n 1)) (fset (fref vx n) (fref bx k)) (fset (fref vy n) (fref by k)) label370 (setf k (+ k 1)) (fset (fref bx k) x1) (fset (fref by k) (fref y 1)) (setf n (+ n 1)) (fset (fref vx n) x1) (fset (fref vy n) (fref y 1)) (go end_label) label400 (setf j mp1) (setf nn mp1) (fset (fref bx mp1) x1) (fset (fref vx mp1) x1) (fset (fref by mp1) (fref y 1)) (fset (fref vy mp1) (fref y 1)) (setf i (+ lmin (- 1))) label401 (setf j0 j) (setf ibeg true) label410 (setf i (+ i 1)) (setf h (+ (fref x i) (- (fref bx j)))) (if (>= h 0.0) (go label410)) (setf dx (abs (+ (fref x i) (- (fref bx j0))))) (setf dy (+ (fref y i) (- (fref by j0)))) (if ibeg (go label420)) (setf r (* (/ dx0 dx) dy)) (if (> r (* onep dy0)) (go label430)) (if (> dy0 (* onep r)) (go label420)) (if (and (= dy0 0.0) (> dy 0.0)) (go label435)) (setf j (+ j (- 1))) (go label421) label420 (setf ibeg false) (setf dx0 dx) (setf dy0 dy) (setf j (+ j0 (- 1))) label421 (fset (fref bx j) (fref x i)) (fset (fref by j) (fref y i)) (setf isav i) label430 (setf h (+ (fref x i) (- xmin))) (if (> h 0.0) (go label410)) label435 (setf i isav) (setf nn (+ nn (- 1))) (fset (fref vx nn) (fref bx j)) (fset (fref vy nn) (fref by j)) (setf h (+ (fref bx j) (- xmin))) (if (> h 0.0) (go label401)) (if (= nn n) (go end_label)) (if (and (= i l) (= k ksav)) (setf nn (+ nn 1))) (fdo ((ii nn (+ ii 1))) ((> ii mp1) nil) (tagbody (setf n (+ n 1)) (fset (fref vx n) (fref vx ii)) (fset (fref vy n) (fref vy ii)) )) (if (= j k) (go end_label)) (if (= i l) (setf j (+ j 1))) (fdo ((ii j (+ ii 1))) ((> ii mp1) nil) (tagbody (setf k (+ k 1)) (fset (fref bx k) (fref bx ii)) (fset (fref by k) (fref by ii)) )) (go end_label) label500 (multiple-value-setq (x y m) (rrsort x y m)) (fdo ((i 1 (+ i 1))) ((> i m) nil) (tagbody (fset (fref bx i) (fref x i)) (fset (fref by i) (fref y i))) ) (setf k mp1) (fset (fref bx k) (fref bx 1)) (fset (fref by k) (fref by 1)) (setf n 3) (fset (fref vx 1) (fref x 1)) (fset (fref vx 2) (fref x m)) (fset (fref vx 3) (fref x 1)) (fset (fref vy 1) (fref y 1)) (fset (fref vy 2) (fref y m)) (fset (fref vy 3) (fref y 1)) (go end_label) end_label (return (values x y m bx by k vx vy n)) ))