1;;; Compiled by f2cl version:
2;;; ("f2cl1.l,v 2edcbd958861 2012/05/30 03:34:52 toy $"
3;;;  "f2cl2.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
4;;;  "f2cl3.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
5;;;  "f2cl4.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
6;;;  "f2cl5.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $"
7;;;  "f2cl6.l,v 1d5cbacbb977 2008/08/24 00:56:27 rtoy $"
8;;;  "macros.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $")
9
10;;; Using Lisp CMU Common Lisp 20d (20D 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 :blas)
18
19
20(let* ((one 1.0) (zero 0.0))
21  (declare (type (double-float 1.0 1.0) one)
22           (type (double-float 0.0 0.0) zero)
23           (ignorable one zero))
24  (defun dgemv (trans m n alpha a lda x incx beta y incy)
25    (declare (type (array double-float (*)) y x a)
26             (type (double-float) beta alpha)
27             (type (f2cl-lib:integer4) incy incx lda n m)
28             (type (simple-string *) trans))
29    (f2cl-lib:with-multi-array-data
30        ((trans character trans-%data% trans-%offset%)
31         (a double-float a-%data% a-%offset%)
32         (x double-float x-%data% x-%offset%)
33         (y double-float y-%data% y-%offset%))
34      (prog ((i 0) (info 0) (ix 0) (iy 0) (j 0) (jx 0) (jy 0) (kx 0) (ky 0)
35             (lenx 0) (leny 0) (temp 0.0))
36        (declare (type (f2cl-lib:integer4) i info ix iy j jx jy kx ky lenx
37                                           leny)
38                 (type (double-float) temp))
39        (setf info 0)
40        (cond
41          ((and (not (lsame trans "N"))
42                (not (lsame trans "T"))
43                (not (lsame trans "C")))
44           (setf info 1))
45          ((< m 0)
46           (setf info 2))
47          ((< n 0)
48           (setf info 3))
49          ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m)))
50           (setf info 6))
51          ((= incx 0)
52           (setf info 8))
53          ((= incy 0)
54           (setf info 11)))
55        (cond
56          ((/= info 0)
57           (xerbla "DGEMV " info)
58           (go end_label)))
59        (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one)))
60            (go end_label))
61        (cond
62          ((lsame trans "N")
63           (setf lenx n)
64           (setf leny m))
65          (t
66           (setf lenx m)
67           (setf leny n)))
68        (cond
69          ((> incx 0)
70           (setf kx 1))
71          (t
72           (setf kx
73                   (f2cl-lib:int-sub 1
74                                     (f2cl-lib:int-mul
75                                      (f2cl-lib:int-sub lenx 1)
76                                      incx)))))
77        (cond
78          ((> incy 0)
79           (setf ky 1))
80          (t
81           (setf ky
82                   (f2cl-lib:int-sub 1
83                                     (f2cl-lib:int-mul
84                                      (f2cl-lib:int-sub leny 1)
85                                      incy)))))
86        (cond
87          ((/= beta one)
88           (cond
89             ((= incy 1)
90              (cond
91                ((= beta zero)
92                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
93                               ((> i leny) nil)
94                   (tagbody
95                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
96                             zero)
97                    label10)))
98                (t
99                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
100                               ((> i leny) nil)
101                   (tagbody
102                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
103                             (* beta
104                                (f2cl-lib:fref y-%data%
105                                               (i)
106                                               ((1 *))
107                                               y-%offset%)))
108                    label20)))))
109             (t
110              (setf iy ky)
111              (cond
112                ((= beta zero)
113                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
114                               ((> i leny) nil)
115                   (tagbody
116                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
117                             zero)
118                     (setf iy (f2cl-lib:int-add iy incy))
119                    label30)))
120                (t
121                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
122                               ((> i leny) nil)
123                   (tagbody
124                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
125                             (* beta
126                                (f2cl-lib:fref y-%data%
127                                               (iy)
128                                               ((1 *))
129                                               y-%offset%)))
130                     (setf iy (f2cl-lib:int-add iy incy))
131                    label40))))))))
132        (if (= alpha zero) (go end_label))
133        (cond
134          ((lsame trans "N")
135           (setf jx kx)
136           (cond
137             ((= incy 1)
138              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
139                            ((> j n) nil)
140                (tagbody
141                  (cond
142                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
143                     (setf temp
144                             (* alpha
145                                (f2cl-lib:fref x-%data%
146                                               (jx)
147                                               ((1 *))
148                                               x-%offset%)))
149                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
150                                   ((> i m) nil)
151                       (tagbody
152                         (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
153                                 (+
154                                  (f2cl-lib:fref y-%data%
155                                                 (i)
156                                                 ((1 *))
157                                                 y-%offset%)
158                                  (* temp
159                                     (f2cl-lib:fref a-%data%
160                                                    (i j)
161                                                    ((1 lda) (1 *))
162                                                    a-%offset%))))
163                        label50))))
164                  (setf jx (f2cl-lib:int-add jx incx))
165                 label60)))
166             (t
167              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
168                            ((> j n) nil)
169                (tagbody
170                  (cond
171                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
172                     (setf temp
173                             (* alpha
174                                (f2cl-lib:fref x-%data%
175                                               (jx)
176                                               ((1 *))
177                                               x-%offset%)))
178                     (setf iy ky)
179                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
180                                   ((> i m) nil)
181                       (tagbody
182                         (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
183                                 (+
184                                  (f2cl-lib:fref y-%data%
185                                                 (iy)
186                                                 ((1 *))
187                                                 y-%offset%)
188                                  (* temp
189                                     (f2cl-lib:fref a-%data%
190                                                    (i j)
191                                                    ((1 lda) (1 *))
192                                                    a-%offset%))))
193                         (setf iy (f2cl-lib:int-add iy incy))
194                        label70))))
195                  (setf jx (f2cl-lib:int-add jx incx))
196                 label80)))))
197          (t
198           (setf jy ky)
199           (cond
200             ((= incx 1)
201              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
202                            ((> j n) nil)
203                (tagbody
204                  (setf temp zero)
205                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
206                                ((> i m) nil)
207                    (tagbody
208                      (setf temp
209                              (+ temp
210                                 (*
211                                  (f2cl-lib:fref a-%data%
212                                                 (i j)
213                                                 ((1 lda) (1 *))
214                                                 a-%offset%)
215                                  (f2cl-lib:fref x-%data%
216                                                 (i)
217                                                 ((1 *))
218                                                 x-%offset%))))
219                     label90))
220                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
221                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
222                             (* alpha temp)))
223                  (setf jy (f2cl-lib:int-add jy incy))
224                 label100)))
225             (t
226              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
227                            ((> j n) nil)
228                (tagbody
229                  (setf temp zero)
230                  (setf ix kx)
231                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
232                                ((> i m) nil)
233                    (tagbody
234                      (setf temp
235                              (+ temp
236                                 (*
237                                  (f2cl-lib:fref a-%data%
238                                                 (i j)
239                                                 ((1 lda) (1 *))
240                                                 a-%offset%)
241                                  (f2cl-lib:fref x-%data%
242                                                 (ix)
243                                                 ((1 *))
244                                                 x-%offset%))))
245                      (setf ix (f2cl-lib:int-add ix incx))
246                     label110))
247                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
248                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
249                             (* alpha temp)))
250                  (setf jy (f2cl-lib:int-add jy incy))
251                 label120))))))
252        (go end_label)
253       end_label
254        (return (values nil nil nil nil nil nil nil nil nil nil nil))))))
255
256(in-package #-gcl #:cl-user #+gcl "CL-USER")
257#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
258(eval-when (:load-toplevel :compile-toplevel :execute)
259  (setf (gethash 'fortran-to-lisp::dgemv fortran-to-lisp::*f2cl-function-info*)
260          (fortran-to-lisp::make-f2cl-finfo
261           :arg-types '((simple-string) (fortran-to-lisp::integer4)
262                        (fortran-to-lisp::integer4) (double-float)
263                        (array double-float (*)) (fortran-to-lisp::integer4)
264                        (array double-float (*)) (fortran-to-lisp::integer4)
265                        (double-float) (array double-float (*))
266                        (fortran-to-lisp::integer4))
267           :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
268           :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
269
270