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 dgemm (transa transb m n k alpha a lda b ldb$ beta c ldc)
25    (declare (type (array double-float (*)) c b a)
26             (type (double-float) beta alpha)
27             (type (f2cl-lib:integer4) ldc ldb$ lda k n m)
28             (type (simple-string *) transb transa))
29    (f2cl-lib:with-multi-array-data
30        ((transa character transa-%data% transa-%offset%)
31         (transb character transb-%data% transb-%offset%)
32         (a double-float a-%data% a-%offset%)
33         (b double-float b-%data% b-%offset%)
34         (c double-float c-%data% c-%offset%))
35      (prog ((temp 0.0) (i 0) (info 0) (j 0) (l 0) (ncola 0) (nrowa 0)
36             (nrowb 0) (nota nil) (notb nil))
37        (declare (type (double-float) temp)
38                 (type (f2cl-lib:integer4) i info j l ncola nrowa nrowb)
39                 (type f2cl-lib:logical nota notb))
40        (setf nota (lsame transa "N"))
41        (setf notb (lsame transb "N"))
42        (cond
43          (nota
44           (setf nrowa m)
45           (setf ncola k))
46          (t
47           (setf nrowa k)
48           (setf ncola m)))
49        (cond
50          (notb
51           (setf nrowb k))
52          (t
53           (setf nrowb n)))
54        (setf info 0)
55        (cond
56          ((and (not nota) (not (lsame transa "C")) (not (lsame transa "T")))
57           (setf info 1))
58          ((and (not notb) (not (lsame transb "C")) (not (lsame transb "T")))
59           (setf info 2))
60          ((< m 0)
61           (setf info 3))
62          ((< n 0)
63           (setf info 4))
64          ((< k 0)
65           (setf info 5))
66          ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 nrowa)))
67           (setf info 8))
68          ((< ldb$
69              (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 nrowb)))
70           (setf info 10))
71          ((< ldc (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m)))
72           (setf info 13)))
73        (cond
74          ((/= info 0)
75           (xerbla "DGEMM " info)
76           (go end_label)))
77        (if (or (= m 0) (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one)))
78            (go end_label))
79        (cond
80          ((= alpha zero)
81           (cond
82             ((= beta zero)
83              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
84                            ((> j n) nil)
85                (tagbody
86                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
87                                ((> i m) nil)
88                    (tagbody
89                      (setf (f2cl-lib:fref c-%data%
90                                           (i j)
91                                           ((1 ldc) (1 *))
92                                           c-%offset%)
93                              zero)
94                     label10))
95                 label20)))
96             (t
97              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
98                            ((> j n) nil)
99                (tagbody
100                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
101                                ((> i m) nil)
102                    (tagbody
103                      (setf (f2cl-lib:fref c-%data%
104                                           (i j)
105                                           ((1 ldc) (1 *))
106                                           c-%offset%)
107                              (* beta
108                                 (f2cl-lib:fref c-%data%
109                                                (i j)
110                                                ((1 ldc) (1 *))
111                                                c-%offset%)))
112                     label30))
113                 label40))))
114           (go end_label)))
115        (cond
116          (notb
117           (cond
118             (nota
119              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
120                            ((> j n) nil)
121                (tagbody
122                  (cond
123                    ((= beta zero)
124                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
125                                   ((> i m) nil)
126                       (tagbody
127                         (setf (f2cl-lib:fref c-%data%
128                                              (i j)
129                                              ((1 ldc) (1 *))
130                                              c-%offset%)
131                                 zero)
132                        label50)))
133                    ((/= beta one)
134                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
135                                   ((> i m) nil)
136                       (tagbody
137                         (setf (f2cl-lib:fref c-%data%
138                                              (i j)
139                                              ((1 ldc) (1 *))
140                                              c-%offset%)
141                                 (* beta
142                                    (f2cl-lib:fref c-%data%
143                                                   (i j)
144                                                   ((1 ldc) (1 *))
145                                                   c-%offset%)))
146                        label60))))
147                  (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
148                                ((> l k) nil)
149                    (tagbody
150                      (cond
151                        ((/= (f2cl-lib:fref b (l j) ((1 ldb$) (1 *))) zero)
152                         (setf temp
153                                 (* alpha
154                                    (f2cl-lib:fref b-%data%
155                                                   (l j)
156                                                   ((1 ldb$) (1 *))
157                                                   b-%offset%)))
158                         (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
159                                       ((> i m) nil)
160                           (tagbody
161                             (setf (f2cl-lib:fref c-%data%
162                                                  (i j)
163                                                  ((1 ldc) (1 *))
164                                                  c-%offset%)
165                                     (+
166                                      (f2cl-lib:fref c-%data%
167                                                     (i j)
168                                                     ((1 ldc) (1 *))
169                                                     c-%offset%)
170                                      (* temp
171                                         (f2cl-lib:fref a-%data%
172                                                        (i l)
173                                                        ((1 lda) (1 *))
174                                                        a-%offset%))))
175                            label70))))
176                     label80))
177                 label90)))
178             (t
179              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
180                            ((> j n) nil)
181                (tagbody
182                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
183                                ((> i m) nil)
184                    (tagbody
185                      (setf temp zero)
186                      (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
187                                    ((> l k) nil)
188                        (tagbody
189                          (setf temp
190                                  (+ temp
191                                     (*
192                                      (f2cl-lib:fref a-%data%
193                                                     (l i)
194                                                     ((1 lda) (1 *))
195                                                     a-%offset%)
196                                      (f2cl-lib:fref b-%data%
197                                                     (l j)
198                                                     ((1 ldb$) (1 *))
199                                                     b-%offset%))))
200                         label100))
201                      (cond
202                        ((= beta zero)
203                         (setf (f2cl-lib:fref c-%data%
204                                              (i j)
205                                              ((1 ldc) (1 *))
206                                              c-%offset%)
207                                 (* alpha temp)))
208                        (t
209                         (setf (f2cl-lib:fref c-%data%
210                                              (i j)
211                                              ((1 ldc) (1 *))
212                                              c-%offset%)
213                                 (+ (* alpha temp)
214                                    (* beta
215                                       (f2cl-lib:fref c-%data%
216                                                      (i j)
217                                                      ((1 ldc) (1 *))
218                                                      c-%offset%))))))
219                     label110))
220                 label120)))))
221          (t
222           (cond
223             (nota
224              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
225                            ((> j n) nil)
226                (tagbody
227                  (cond
228                    ((= beta zero)
229                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
230                                   ((> i m) nil)
231                       (tagbody
232                         (setf (f2cl-lib:fref c-%data%
233                                              (i j)
234                                              ((1 ldc) (1 *))
235                                              c-%offset%)
236                                 zero)
237                        label130)))
238                    ((/= beta one)
239                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
240                                   ((> i m) nil)
241                       (tagbody
242                         (setf (f2cl-lib:fref c-%data%
243                                              (i j)
244                                              ((1 ldc) (1 *))
245                                              c-%offset%)
246                                 (* beta
247                                    (f2cl-lib:fref c-%data%
248                                                   (i j)
249                                                   ((1 ldc) (1 *))
250                                                   c-%offset%)))
251                        label140))))
252                  (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
253                                ((> l k) nil)
254                    (tagbody
255                      (cond
256                        ((/= (f2cl-lib:fref b (j l) ((1 ldb$) (1 *))) zero)
257                         (setf temp
258                                 (* alpha
259                                    (f2cl-lib:fref b-%data%
260                                                   (j l)
261                                                   ((1 ldb$) (1 *))
262                                                   b-%offset%)))
263                         (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
264                                       ((> i m) nil)
265                           (tagbody
266                             (setf (f2cl-lib:fref c-%data%
267                                                  (i j)
268                                                  ((1 ldc) (1 *))
269                                                  c-%offset%)
270                                     (+
271                                      (f2cl-lib:fref c-%data%
272                                                     (i j)
273                                                     ((1 ldc) (1 *))
274                                                     c-%offset%)
275                                      (* temp
276                                         (f2cl-lib:fref a-%data%
277                                                        (i l)
278                                                        ((1 lda) (1 *))
279                                                        a-%offset%))))
280                            label150))))
281                     label160))
282                 label170)))
283             (t
284              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
285                            ((> j n) nil)
286                (tagbody
287                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
288                                ((> i m) nil)
289                    (tagbody
290                      (setf temp zero)
291                      (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
292                                    ((> l k) nil)
293                        (tagbody
294                          (setf temp
295                                  (+ temp
296                                     (*
297                                      (f2cl-lib:fref a-%data%
298                                                     (l i)
299                                                     ((1 lda) (1 *))
300                                                     a-%offset%)
301                                      (f2cl-lib:fref b-%data%
302                                                     (j l)
303                                                     ((1 ldb$) (1 *))
304                                                     b-%offset%))))
305                         label180))
306                      (cond
307                        ((= beta zero)
308                         (setf (f2cl-lib:fref c-%data%
309                                              (i j)
310                                              ((1 ldc) (1 *))
311                                              c-%offset%)
312                                 (* alpha temp)))
313                        (t
314                         (setf (f2cl-lib:fref c-%data%
315                                              (i j)
316                                              ((1 ldc) (1 *))
317                                              c-%offset%)
318                                 (+ (* alpha temp)
319                                    (* beta
320                                       (f2cl-lib:fref c-%data%
321                                                      (i j)
322                                                      ((1 ldc) (1 *))
323                                                      c-%offset%))))))
324                     label190))
325                 label200))))))
326        (go end_label)
327       end_label
328        (return
329         (values nil nil nil nil nil nil nil nil nil nil nil nil nil))))))
330
331(in-package #-gcl #:cl-user #+gcl "CL-USER")
332#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
333(eval-when (:load-toplevel :compile-toplevel :execute)
334  (setf (gethash 'fortran-to-lisp::dgemm fortran-to-lisp::*f2cl-function-info*)
335          (fortran-to-lisp::make-f2cl-finfo
336           :arg-types '((simple-string) (simple-string)
337                        (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
338                        (fortran-to-lisp::integer4) (double-float)
339                        (array double-float (*)) (fortran-to-lisp::integer4)
340                        (array double-float (*)) (fortran-to-lisp::integer4)
341                        (double-float) (array double-float (*))
342                        (fortran-to-lisp::integer4))
343           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil
344                            nil)
345           :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
346
347