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