(proclaim '(special dly4 dlx4 tdly3 tdlx3 dly dlx ns js ms is nit mit dit cit bit ait l k kswy kswx ) ) (declare (type double-float dly4)) (declare (type double-float dlx4)) (declare (type double-float tdly3)) (declare (type double-float tdlx3)) (declare (type double-float dly)) (declare (type double-float dlx)) (declare (type fixnum ns)) (declare (type fixnum js)) (declare (type fixnum ms)) (declare (type fixnum is)) (declare (type fixnum nit)) (declare (type fixnum mit)) (declare (type double-float dit)) (declare (type double-float cit)) (declare (type double-float bit)) (declare (type double-float ait)) (declare (type fixnum l)) (declare (type fixnum k)) (declare (type fixnum kswy)) (declare (type fixnum kswx)) (defun minsol (usol idmn zn zm pertb) (declare (type (simple-array double-float (* *)) usol)) (declare (type fixnum idmn)) (declare (type (simple-array double-float (*)) zn)) (declare (type (simple-array double-float (*)) zm)) (declare (type double-float pertb)) (prog ((pertrb 0.0d0) (jj 0) (j 0) (ii 0) (i 0) (ete 0.0d0) (ute 0.0d0) (jfnl 0) (jstr 0) (ifnl 0) (istr 0) ) (declare (type double-float pertrb)) (declare (type fixnum jj)) (declare (type fixnum j)) (declare (type fixnum ii)) (declare (type fixnum i)) (declare (type double-float ete)) (declare (type double-float ute)) (declare (type fixnum jfnl)) (declare (type fixnum jstr)) (declare (type fixnum ifnl)) (declare (type fixnum istr)) (setf istr 1) (setf ifnl k) (setf jstr 1) (setf jfnl l) (setf ute 0.0) (setf ete 0.0) (fdo ((i is (+ i 1))) ((> i ms) nil) (tagbody (setf ii (+ (+ i (- is)) 1)) (fdo ((j js (+ j 1))) ((> j ns) nil) (tagbody (setf jj (+ (+ j (- js)) 1)) (setf ete (+ ete (* (fref zm ii) (fref zn jj)))) (setf ute (+ ute (* (* (fref usol i j) (fref zm ii)) (fref zn jj)))) )))) (setf pertrb (/ ute ete)) (fdo ((i istr (+ i 1))) ((> i ifnl) nil) (tagbody (fdo ((j jstr (+ j 1))) ((> j jfnl) nil) (tagbody (fset (fref usol i j) (+ (fref usol i j) (- pertrb)))) ))) (return (values usol idmn zn zm pertb)) ))