(defun mkp (n m p w k bck xstar vstar wk iwk num) (declare (type fixnum n)) (declare (type fixnum m)) (declare (type (simple-array fixnum (*)) p)) (declare (type (simple-array fixnum (*)) w)) (declare (type (simple-array fixnum (*)) k)) (declare (type fixnum bck)) (declare (type (simple-array fixnum (*)) xstar)) (declare (type fixnum vstar)) (declare (type (simple-array float (*)) wk)) (declare (type (simple-array fixnum (*)) iwk)) (declare (type fixnum num)) (prog ((bs 0) (ps 0) (ws 0) (xs 0) (f 0) (pbl 0) (q 0) (v 0) (b 0) (ubb 0) (bb 0) (bl 0) (x 0) (xl 0) (jnn 0) (np1 0) (lxi 0) (lx 0) (npl 0) (l 0) (jn 0) (jj 0) (n5 0) (i 0) (j 0) (isumw 0) (minw 0) (maxw 0) (aw 0.0d0) (ap 0.0d0) (mn 0) ) (declare (type fixnum bs)) (declare (type fixnum ps)) (declare (type fixnum ws)) (declare (type fixnum xs)) (declare (type fixnum f)) (declare (type fixnum pbl)) (declare (type fixnum q)) (declare (type fixnum v)) (declare (type fixnum b)) (declare (type fixnum ubb)) (declare (type fixnum bb)) (declare (type fixnum bl)) (declare (type fixnum x)) (declare (type fixnum xl)) (declare (type fixnum jnn)) (declare (type fixnum np1)) (declare (type fixnum lxi)) (declare (type fixnum lx)) (declare (type fixnum npl)) (declare (type fixnum l)) (declare (type fixnum jn)) (declare (type fixnum jj)) (declare (type fixnum n5)) (declare (type fixnum i)) (declare (type fixnum j)) (declare (type fixnum isumw)) (declare (type fixnum minw)) (declare (type fixnum maxw)) (declare (type double-float aw)) (declare (type double-float ap)) (declare (type fixnum mn)) (if (or (< m 1) (< n 2)) (go label100)) (setf mn (* m n)) (if (< num (+ (+ (+ (* 5 m) (* 14 n)) (* 4 mn)) 3)) (go label160)) (if (or (<= (fref p 1) 0) (<= (fref w 1) 0)) (go label110)) (setf ap (fref p 1)) (setf aw (fref w 1)) (fset (fref wk 1) (/ (* -1 ap) aw)) (setf maxw (fref w 1)) (setf minw (fref w 1)) (setf isumw (fref w 1)) (fdo ((j 2 (+ j 1))) ((> j n) nil) (tagbody (if (or (<= (fref p j) 0) (<= (fref w j) 0)) (go label110)) (setf ap (fref p j)) (setf aw (fref w j)) (fset (fref wk j) (/ (* -1 ap) aw)) (if (> (fref w j) maxw) (setf maxw (fref w j))) (if (< (fref w j) minw) (setf minw (fref w j))) (setf isumw (+ isumw (fref w j))) )) (if (<= (fref k 1) 0) (go label110)) (if (= m 1) (go label30)) (fdo ((i 2 (+ i 1))) ((> i m) nil) (tagbody (if (<= (fref k i) 0) (go label110)) (if (< (fref k i) (fref k (+ i (- 1)))) (go label150)) )) label30 (if (> minw (fref k 1)) (go label120)) (if (> maxw (fref k m)) (go label130)) (if (<= isumw (fref k m)) (go label140)) (setf vstar 0) (setf n5 (* 5 n)) (fdo ((j 1 (+ j 1))) ((> j n) nil) (tagbody (setf jj (+ n5 j)) (fset (fref iwk jj) j)) ) (multiple-value-setq (wk dummy_var n) (risort wk (fref iwk (+ n5 1)) n)) (fdo ((j 1 (+ j 1))) ((> j n) nil) (tagbody (fset (fref iwk j) (fref p j)) (setf jn (+ j n)) (fset (fref iwk jn) (fref w j)) )) (fdo ((j 1 (+ j 1))) ((> j n) nil) (tagbody (setf jj (+ n5 j)) (setf l (fref iwk jj)) (fset (fref p j) (fref iwk l)) (setf npl (+ n l)) (fset (fref w j) (fref iwk npl)) )) (setf lx (+ jj 1)) (setf lxi (+ lx n)) (setf bs (+ lxi n)) (setf xs (+ bs n)) (setf ubb (+ xs n)) (setf np1 (+ n 1)) (setf b (+ ubb n)) (setf ps (+ b np1)) (setf ws (+ ps np1)) (setf f (+ ws np1)) (setf pbl (+ f m)) (setf q (+ pbl m)) (setf v (+ q m)) (setf bb (+ v m)) (setf x (+ bb mn)) (setf xl (+ x mn)) (setf bl (+ xl mn)) (multiple-value-setq (n m p w k bck xstar vstar np1 n5 dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var dummy_var ) (mkp1 n m p w k bck xstar vstar np1 n5 (fref iwk bb) (fref iwk bl) (fref iwk x) (fref iwk xl) (fref iwk b) (fref iwk ubb) (fref iwk lx) (fref iwk lxi) (fref iwk f) (fref iwk pbl) (fref iwk q) (fref iwk v) (fref iwk bs) (fref iwk ps) (fref iwk ws) (fref iwk xs) (fref iwk 1) )) (fdo ((j 1 (+ j 1))) ((> j n) nil) (tagbody (fset (fref iwk j) (fref p j)) (setf jn (+ j n)) (fset (fref iwk jn) (fref w j)) (setf jnn (+ jn n)) (fset (fref iwk jnn) (fref xstar j)) )) (fdo ((j 1 (+ j 1))) ((> j n) nil) (tagbody (setf jj (+ n5 j)) (setf l (fref iwk jj)) (fset (fref p l) (fref iwk j)) (setf jn (+ j n)) (fset (fref w l) (fref iwk jn)) (setf jnn (+ jn n)) (fset (fref xstar l) (fref iwk jnn)) )) (go end_label) label100 (setf vstar (- 1)) (go end_label) label110 (setf vstar (- 2)) (go end_label) label120 (setf vstar (- 3)) (go end_label) label130 (setf vstar (- 4)) (go end_label) label140 (setf vstar (- 5)) (go end_label) label150 (setf vstar (- 7)) (go end_label) label160 (setf vstar (- 8)) (go end_label) end_label (return (values n m p w k bck xstar vstar wk iwk num)) ))