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