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 dgefa (a lda n ipvt info)
21  (declare (type (array f2cl-lib:integer4 (*)) ipvt)
22           (type (f2cl-lib:integer4) info n lda)
23           (type (array double-float (*)) a))
24  (f2cl-lib:with-multi-array-data
25      ((a double-float a-%data% a-%offset%)
26       (ipvt f2cl-lib:integer4 ipvt-%data% ipvt-%offset%))
27    (prog ((j 0) (k 0) (kp1 0) (l 0) (nm1 0) (t$ 0.0))
28      (declare (type (double-float) t$)
29               (type (f2cl-lib:integer4) nm1 l kp1 k j))
30      (setf info 0)
31      (setf nm1 (f2cl-lib:int-sub n 1))
32      (if (< nm1 1) (go label70))
33      (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
34                    ((> k nm1) nil)
35        (tagbody
36          (setf kp1 (f2cl-lib:int-add k 1))
37          (setf l
38                  (f2cl-lib:int-sub
39                   (f2cl-lib:int-add
40                    (idamax (f2cl-lib:int-add (f2cl-lib:int-sub n k) 1)
41                     (f2cl-lib:array-slice a
42                                           double-float
43                                           (k k)
44                                           ((1 lda) (1 1)))
45                     1)
46                    k)
47                   1))
48          (setf (f2cl-lib:fref ipvt-%data% (k) ((1 1)) ipvt-%offset%) l)
49          (if (= (f2cl-lib:fref a-%data% (l k) ((1 lda) (1 1)) a-%offset%) 0.0)
50              (go label40))
51          (if (= l k) (go label10))
52          (setf t$ (f2cl-lib:fref a-%data% (l k) ((1 lda) (1 1)) a-%offset%))
53          (setf (f2cl-lib:fref a-%data% (l k) ((1 lda) (1 1)) a-%offset%)
54                  (f2cl-lib:fref a-%data% (k k) ((1 lda) (1 1)) a-%offset%))
55          (setf (f2cl-lib:fref a-%data% (k k) ((1 lda) (1 1)) a-%offset%) t$)
56         label10
57          (setf t$
58                  (/ -1.0
59                     (f2cl-lib:fref a-%data%
60                                    (k k)
61                                    ((1 lda) (1 1))
62                                    a-%offset%)))
63          (dscal (f2cl-lib:int-sub n k) t$
64           (f2cl-lib:array-slice a double-float ((+ k 1) k) ((1 lda) (1 1))) 1)
65          (f2cl-lib:fdo (j kp1 (f2cl-lib:int-add j 1))
66                        ((> j n) nil)
67            (tagbody
68              (setf t$
69                      (f2cl-lib:fref a-%data%
70                                     (l j)
71                                     ((1 lda) (1 1))
72                                     a-%offset%))
73              (if (= l k) (go label20))
74              (setf (f2cl-lib:fref a-%data% (l j) ((1 lda) (1 1)) a-%offset%)
75                      (f2cl-lib:fref a-%data%
76                                     (k j)
77                                     ((1 lda) (1 1))
78                                     a-%offset%))
79              (setf (f2cl-lib:fref a-%data% (k j) ((1 lda) (1 1)) a-%offset%)
80                      t$)
81             label20
82              (daxpy (f2cl-lib:int-sub n k) t$
83               (f2cl-lib:array-slice a
84                                     double-float
85                                     ((+ k 1) k)
86                                     ((1 lda) (1 1)))
87               1
88               (f2cl-lib:array-slice a
89                                     double-float
90                                     ((+ k 1) j)
91                                     ((1 lda) (1 1)))
92               1)
93             label30))
94          (go label50)
95         label40
96          (setf info k)
97         label50
98         label60))
99     label70
100      (setf (f2cl-lib:fref ipvt-%data% (n) ((1 1)) ipvt-%offset%) n)
101      (if (= (f2cl-lib:fref a-%data% (n n) ((1 lda) (1 1)) a-%offset%) 0.0)
102          (setf info n))
103      (go end_label)
104     end_label
105      (return (values nil nil nil nil info)))))
106
107(in-package #-gcl #:cl-user #+gcl "CL-USER")
108#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
109(eval-when (:load-toplevel :compile-toplevel :execute)
110  (setf (gethash 'fortran-to-lisp::dgefa fortran-to-lisp::*f2cl-function-info*)
111          (fortran-to-lisp::make-f2cl-finfo
112           :arg-types '((array double-float (*)) (fortran-to-lisp::integer4)
113                        (fortran-to-lisp::integer4)
114                        (array fortran-to-lisp::integer4 (1))
115                        (fortran-to-lisp::integer4))
116           :return-values '(nil nil nil nil fortran-to-lisp::info)
117           :calls '(fortran-to-lisp::daxpy fortran-to-lisp::dscal
118                    fortran-to-lisp::idamax))))
119
120