1;;; Compiled by f2cl version: 2;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $" 3;;; "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $" 4;;; "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $" 5;;; "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $" 6;;; "f2cl5.l,v 1.204 2010/02/23 05:21:30 rtoy Exp $" 7;;; "f2cl6.l,v 1.48 2008/08/24 00:56:27 rtoy Exp $" 8;;; "macros.l,v 1.114 2010/05/17 01:42:14 rtoy Exp $") 9 10;;; Using Lisp CMU Common Lisp CVS Head 2010-05-25 18:21:07 (20A Unicode) 11;;; 12;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t) 13;;; (:coerce-assigns :as-needed) (:array-type ':array) 14;;; (:array-slicing t) (:declare-common nil) 15;;; (:float-format double-float)) 16 17(in-package :colnew) 18 19 20(defun factrb (w ipivot d nrow ncol last$ info) 21 (declare (type (f2cl-lib:integer4) info last$ ncol nrow) 22 (type (array f2cl-lib:integer4 (*)) ipivot) 23 (type (array double-float (*)) d w)) 24 (f2cl-lib:with-multi-array-data 25 ((w double-float w-%data% w-%offset%) 26 (d double-float d-%data% d-%offset%) 27 (ipivot f2cl-lib:integer4 ipivot-%data% ipivot-%offset%)) 28 (prog ((dabs$ 0.0) (dmax1$ 0.0) (colmax 0.0) (t$ 0.0) (s 0.0) (i 0) (j 0) 29 (k 0) (l 0) (kp1 0)) 30 (declare (type (f2cl-lib:integer4) kp1 l k j i) 31 (type (double-float) s t$ colmax dmax1$ dabs$)) 32 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 33 ((> i nrow) nil) 34 (tagbody 35 (setf (f2cl-lib:fref d-%data% (i) ((1 nrow)) d-%offset%) 0.0) 36 label10)) 37 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) 38 ((> j ncol) nil) 39 (tagbody 40 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 41 ((> i nrow) nil) 42 (tagbody 43 (setf (f2cl-lib:fref d-%data% (i) ((1 nrow)) d-%offset%) 44 (f2cl-lib:dmax1 45 (f2cl-lib:fref d-%data% (i) ((1 nrow)) d-%offset%) 46 (f2cl-lib:dabs 47 (f2cl-lib:fref w-%data% 48 (i j) 49 ((1 nrow) (1 ncol)) 50 w-%offset%)))) 51 label20)))) 52 label20 53 (setf k 1) 54 label30 55 (if (= (f2cl-lib:fref d-%data% (k) ((1 nrow)) d-%offset%) 0.0) 56 (go label90)) 57 (if (= k nrow) (go label80)) 58 (setf l k) 59 (setf kp1 (f2cl-lib:int-add k 1)) 60 (setf colmax 61 (/ 62 (f2cl-lib:dabs 63 (f2cl-lib:fref w-%data% (k k) ((1 nrow) (1 ncol)) w-%offset%)) 64 (f2cl-lib:fref d-%data% (k) ((1 nrow)) d-%offset%))) 65 (f2cl-lib:fdo (i kp1 (f2cl-lib:int-add i 1)) 66 ((> i nrow) nil) 67 (tagbody 68 (if 69 (<= 70 (f2cl-lib:dabs 71 (f2cl-lib:fref w-%data% (i k) ((1 nrow) (1 ncol)) w-%offset%)) 72 (* colmax (f2cl-lib:fref d-%data% (i) ((1 nrow)) d-%offset%))) 73 (go label40)) 74 (setf colmax 75 (/ 76 (f2cl-lib:dabs 77 (f2cl-lib:fref w-%data% 78 (i k) 79 ((1 nrow) (1 ncol)) 80 w-%offset%)) 81 (f2cl-lib:fref d-%data% (i) ((1 nrow)) d-%offset%))) 82 (setf l i) 83 label40)) 84 (setf (f2cl-lib:fref ipivot-%data% (k) ((1 nrow)) ipivot-%offset%) l) 85 (setf t$ (f2cl-lib:fref w-%data% (l k) ((1 nrow) (1 ncol)) w-%offset%)) 86 (setf s (f2cl-lib:fref d-%data% (l) ((1 nrow)) d-%offset%)) 87 (if (= l k) (go label50)) 88 (setf (f2cl-lib:fref w-%data% (l k) ((1 nrow) (1 ncol)) w-%offset%) 89 (f2cl-lib:fref w-%data% (k k) ((1 nrow) (1 ncol)) w-%offset%)) 90 (setf (f2cl-lib:fref w-%data% (k k) ((1 nrow) (1 ncol)) w-%offset%) t$) 91 (setf (f2cl-lib:fref d-%data% (l) ((1 nrow)) d-%offset%) 92 (f2cl-lib:fref d-%data% (k) ((1 nrow)) d-%offset%)) 93 (setf (f2cl-lib:fref d-%data% (k) ((1 nrow)) d-%offset%) s) 94 label50 95 (if 96 (<= 97 (+ (f2cl-lib:dabs t$) 98 (f2cl-lib:fref d-%data% (k) ((1 nrow)) d-%offset%)) 99 (f2cl-lib:fref d-%data% (k) ((1 nrow)) d-%offset%)) 100 (go label90)) 101 (setf t$ (/ -1.0 t$)) 102 (f2cl-lib:fdo (i kp1 (f2cl-lib:int-add i 1)) 103 ((> i nrow) nil) 104 (tagbody 105 label60 106 (setf (f2cl-lib:fref w-%data% (i k) ((1 nrow) (1 ncol)) w-%offset%) 107 (* 108 (f2cl-lib:fref w-%data% 109 (i k) 110 ((1 nrow) (1 ncol)) 111 w-%offset%) 112 t$)))) 113 (f2cl-lib:fdo (j kp1 (f2cl-lib:int-add j 1)) 114 ((> j ncol) nil) 115 (tagbody 116 (setf t$ 117 (f2cl-lib:fref w-%data% 118 (l j) 119 ((1 nrow) (1 ncol)) 120 w-%offset%)) 121 (if (= l k) (go label62)) 122 (setf (f2cl-lib:fref w-%data% (l j) ((1 nrow) (1 ncol)) w-%offset%) 123 (f2cl-lib:fref w-%data% 124 (k j) 125 ((1 nrow) (1 ncol)) 126 w-%offset%)) 127 (setf (f2cl-lib:fref w-%data% (k j) ((1 nrow) (1 ncol)) w-%offset%) 128 t$) 129 label62 130 (if (= t$ 0.0) (go label70)) 131 (f2cl-lib:fdo (i kp1 (f2cl-lib:int-add i 1)) 132 ((> i nrow) nil) 133 (tagbody 134 label64 135 (setf (f2cl-lib:fref w-%data% 136 (i j) 137 ((1 nrow) (1 ncol)) 138 w-%offset%) 139 (+ 140 (f2cl-lib:fref w-%data% 141 (i j) 142 ((1 nrow) (1 ncol)) 143 w-%offset%) 144 (* 145 (f2cl-lib:fref w-%data% 146 (i k) 147 ((1 nrow) (1 ncol)) 148 w-%offset%) 149 t$))))) 150 label70)) 151 (setf k kp1) 152 (if (<= k last$) (go label30)) 153 (go end_label) 154 label80 155 (if 156 (> 157 (+ 158 (f2cl-lib:dabs 159 (f2cl-lib:fref w-%data% (nrow nrow) ((1 nrow) (1 ncol)) w-%offset%)) 160 (f2cl-lib:fref d-%data% (nrow) ((1 nrow)) d-%offset%)) 161 (f2cl-lib:fref d-%data% (nrow) ((1 nrow)) d-%offset%)) 162 (go end_label)) 163 label90 164 (setf info k) 165 (go end_label) 166 end_label 167 (return (values nil nil nil nil nil nil info))))) 168 169(in-package #-gcl #:cl-user #+gcl "CL-USER") 170#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) 171(eval-when (:load-toplevel :compile-toplevel :execute) 172 (setf (gethash 'fortran-to-lisp::factrb 173 fortran-to-lisp::*f2cl-function-info*) 174 (fortran-to-lisp::make-f2cl-finfo 175 :arg-types '((array double-float (*)) 176 (array fortran-to-lisp::integer4 (*)) 177 (array double-float (*)) (fortran-to-lisp::integer4) 178 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4) 179 (fortran-to-lisp::integer4)) 180 :return-values '(nil nil nil nil nil nil fortran-to-lisp::info) 181 :calls 'nil))) 182 183