(require "f2cl_macros")

(defun simplx
 (a m n mp np m1 m2 m3 icase izrov iposv &key (mmax 100) (eps 1.0E-6))
 (declare (type (simple-array double-float (* *)) a)) (declare (type fixnum m))
 (declare (type fixnum n)) (declare (type fixnum mp))
 (declare (type fixnum np)) (declare (type fixnum m1))
 (declare (type fixnum m2)) (declare (type fixnum m3))
 (declare (type fixnum icase)) (declare (type (simple-array fixnum (*)) izrov))
 (declare (type (simple-array fixnum (*)) iposv)) (declare (type fixnum mmax))
 (declare (type double-float eps))
 (prog
  ((l1 (make-array mmax :element-type 'fixnum))
   (l2 (make-array mmax :element-type 'fixnum))
   (l3 (make-array mmax :element-type 'fixnum)) (kp 0) (kh 0) (is 0) (ip 0)
   (m12 0) (bmax 0.0d0) (q1 0.0d0) (ir 0) (i 0) (nl2 0) (k 0) (nl1 0)
  )
  (declare (type (simple-array fixnum (*)) l1))
  (declare (type (simple-array fixnum (*)) l2))
  (declare (type (simple-array fixnum (*)) l3)) (declare (type fixnum kp))
  (declare (type fixnum kh)) (declare (type fixnum is))
  (declare (type fixnum ip)) (declare (type fixnum m12))
  (declare (type double-float bmax)) (declare (type double-float q1))
  (declare (type fixnum ir)) (declare (type fixnum i))
  (declare (type fixnum nl2)) (declare (type fixnum k))
  (declare (type fixnum nl1))
  (if (/= m (+ (+ m1 m2) m3)) (error "Bad input constraint counts."))
  (setf nl1 n)
  (fdo ((k 1 (+ k 1))) ((> k n) nil)
   (tagbody (fset (fref l1 k) k) (fset (fref izrov k) k))
  )
  (setf nl2 m)
  (fdo ((i 1 (+ i 1))) ((> i m) nil)
   (tagbody (if (< (fref a (+ i 1) 1) 0.0) (error "Bad input tableau."))
    (fset (fref l2 i) i) (fset (fref iposv i) (+ n i))
  ))
  (fdo ((i 1 (+ i 1))) ((> i m2) nil) (tagbody (fset (fref l3 i) 1)))
  (setf ir 0) (if (= (+ m2 m3) 0) (go label30)) (setf ir 1)
  (fdo ((k 1 (+ k 1))) ((> k (+ n 1)) nil)
   (tagbody (setf q1 0.0)
    (fdo ((i (+ m1 1) (+ i 1))) ((> i m) nil)
     (tagbody (setf q1 (+ q1 (fref a (+ i 1) k))))
    )
    (fset (fref a (+ m 2) k) (- q1))
  ))
  label10
  (multiple-value-setq (a mp np dummy_var l1 nl1 dummy_var kp bmax)
   (simp1 a mp np (+ m 1) l1 nl1 0 kp bmax)
  )
  (cond
   ((and (<= bmax eps) (< (fref a (+ m 2) 1) (- eps))) (setf icase (- 1))
    (go end_label)
   )
   ((and (<= bmax eps) (<= (fref a (+ m 2) 1) eps)) (setf m12 (+ (+ m1 m2) 1))
    (cond
     ((<= m12 m)
      (fdo ((ip m12 (+ ip 1))) ((> ip m) nil)
       (tagbody
        (cond
         ((= (fref iposv ip) (+ ip n))
          (multiple-value-setq (a mp np ip l1 nl1 dummy_var kp bmax)
           (simp1 a mp np ip l1 nl1 1 kp bmax)
          )
          (if (> bmax 0.0) (go label1))
    ))))))
    (setf ir 0) (setf m12 (+ m12 (- 1))) (if (> (+ m1 1) m12) (go label30))
    (fdo ((i (+ m1 1) (+ i 1))) ((> i m12) nil)
     (tagbody
      (cond
       ((= (fref l3 (+ i (- m1))) 1)
        (fdo ((k 1 (+ k 1))) ((> k (+ n 1)) nil)
         (tagbody (fset (fref a (+ i 1) k) (- (fref a (+ i 1) k))))
    )))))
    (go label30)
  ))
  (multiple-value-setq (a m n mp np l2 nl2 ip kp q1)
   (simp2 a m n mp np l2 nl2 ip kp q1)
  )
  (cond ((= ip 0) (setf icase (- 1)) (go end_label))) label1
  (multiple-value-setq (a mp np dummy_var n ip kp)
   (simp3 a mp np (+ m 1) n ip kp)
  )
  (cond
   ((>= (fref iposv ip) (+ (+ (+ n m1) m2) 1))
    (tagbody
     (fdo ((k 1 (+ k 1))) ((> k nl1) nil)
      (tagbody (if (= (fref l1 k) kp) (go label2)))
     )
     label2 (setf nl1 (+ nl1 (- 1)))
     (fdo ((is k (+ is 1))) ((> is nl1) nil)
      (tagbody (fset (fref l1 is) (fref l1 (+ is 1))))
   )))
   (t (if (< (fref iposv ip) (+ (+ n m1) 1)) (go label20))
    (setf kh (+ (+ (fref iposv ip) (- m1)) (- n)))
    (if (= (fref l3 kh) 0) (go label20)) (fset (fref l3 kh) 0)
  ))
  (fset (fref a (+ m 2) (+ kp 1)) (+ (fref a (+ m 2) (+ kp 1)) 1.0))
  (fdo ((i 1 (+ i 1))) ((> i (+ m 2)) nil)
   (tagbody (fset (fref a i (+ kp 1)) (- (fref a i (+ kp 1)))))
  )
  label20 (setf is (fref izrov kp)) (fset (fref izrov kp) (fref iposv ip))
  (fset (fref iposv ip) is) (if (/= ir 0) (go label10)) label30
  (multiple-value-setq (a mp np dummy_var l1 nl1 dummy_var kp bmax)
   (simp1 a mp np 0 l1 nl1 0 kp bmax)
  )
  (cond ((<= bmax 0.0) (setf icase 0) (go end_label)))
  (multiple-value-setq (a m n mp np l2 nl2 ip kp q1)
   (simp2 a m n mp np l2 nl2 ip kp q1)
  )
  (cond ((= ip 0) (setf icase 1) (go end_label)))
  (multiple-value-setq (a mp np m n ip kp) (simp3 a mp np m n ip kp))
  (go label20) end_label
  (return (values a m n mp np m1 m2 m3 icase izrov iposv))
))