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 dgbmv (trans m n kl ku 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 ku kl 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) (k 0) (kup1 0)
35             (kx 0) (ky 0) (lenx 0) (leny 0) (temp 0.0))
36        (declare (type (f2cl-lib:integer4) i info ix iy j jx jy k kup1 kx ky
37                                           lenx 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          ((< kl 0)
50           (setf info 4))
51          ((< ku 0)
52           (setf info 5))
53          ((< lda (f2cl-lib:int-add kl ku 1))
54           (setf info 8))
55          ((= incx 0)
56           (setf info 10))
57          ((= incy 0)
58           (setf info 13)))
59        (cond
60          ((/= info 0)
61           (xerbla "DGBMV " info)
62           (go end_label)))
63        (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one)))
64            (go end_label))
65        (cond
66          ((lsame trans "N")
67           (setf lenx n)
68           (setf leny m))
69          (t
70           (setf lenx m)
71           (setf leny n)))
72        (cond
73          ((> incx 0)
74           (setf kx 1))
75          (t
76           (setf kx
77                   (f2cl-lib:int-sub 1
78                                     (f2cl-lib:int-mul
79                                      (f2cl-lib:int-sub lenx 1)
80                                      incx)))))
81        (cond
82          ((> incy 0)
83           (setf ky 1))
84          (t
85           (setf ky
86                   (f2cl-lib:int-sub 1
87                                     (f2cl-lib:int-mul
88                                      (f2cl-lib:int-sub leny 1)
89                                      incy)))))
90        (cond
91          ((/= beta one)
92           (cond
93             ((= incy 1)
94              (cond
95                ((= beta zero)
96                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
97                               ((> i leny) nil)
98                   (tagbody
99                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
100                             zero)
101                    label10)))
102                (t
103                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
104                               ((> i leny) nil)
105                   (tagbody
106                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
107                             (* beta
108                                (f2cl-lib:fref y-%data%
109                                               (i)
110                                               ((1 *))
111                                               y-%offset%)))
112                    label20)))))
113             (t
114              (setf iy ky)
115              (cond
116                ((= beta zero)
117                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
118                               ((> i leny) nil)
119                   (tagbody
120                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
121                             zero)
122                     (setf iy (f2cl-lib:int-add iy incy))
123                    label30)))
124                (t
125                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
126                               ((> i leny) nil)
127                   (tagbody
128                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
129                             (* beta
130                                (f2cl-lib:fref y-%data%
131                                               (iy)
132                                               ((1 *))
133                                               y-%offset%)))
134                     (setf iy (f2cl-lib:int-add iy incy))
135                    label40))))))))
136        (if (= alpha zero) (go end_label))
137        (setf kup1 (f2cl-lib:int-add ku 1))
138        (cond
139          ((lsame trans "N")
140           (setf jx kx)
141           (cond
142             ((= incy 1)
143              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
144                            ((> j n) nil)
145                (tagbody
146                  (cond
147                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
148                     (setf temp
149                             (* alpha
150                                (f2cl-lib:fref x-%data%
151                                               (jx)
152                                               ((1 *))
153                                               x-%offset%)))
154                     (setf k (f2cl-lib:int-sub kup1 j))
155                     (f2cl-lib:fdo (i
156                                    (max (the f2cl-lib:integer4 1)
157                                         (the f2cl-lib:integer4
158                                              (f2cl-lib:int-add j
159                                                                (f2cl-lib:int-sub
160                                                                 ku))))
161                                    (f2cl-lib:int-add i 1))
162                                   ((> i
163                                       (min (the f2cl-lib:integer4 m)
164                                            (the f2cl-lib:integer4
165                                                 (f2cl-lib:int-add j kl))))
166                                    nil)
167                       (tagbody
168                         (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
169                                 (+
170                                  (f2cl-lib:fref y-%data%
171                                                 (i)
172                                                 ((1 *))
173                                                 y-%offset%)
174                                  (* temp
175                                     (f2cl-lib:fref a-%data%
176                                                    ((f2cl-lib:int-add k i) j)
177                                                    ((1 lda) (1 *))
178                                                    a-%offset%))))
179                        label50))))
180                  (setf jx (f2cl-lib:int-add jx incx))
181                 label60)))
182             (t
183              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
184                            ((> j n) nil)
185                (tagbody
186                  (cond
187                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
188                     (setf temp
189                             (* alpha
190                                (f2cl-lib:fref x-%data%
191                                               (jx)
192                                               ((1 *))
193                                               x-%offset%)))
194                     (setf iy ky)
195                     (setf k (f2cl-lib:int-sub kup1 j))
196                     (f2cl-lib:fdo (i
197                                    (max (the f2cl-lib:integer4 1)
198                                         (the f2cl-lib:integer4
199                                              (f2cl-lib:int-add j
200                                                                (f2cl-lib:int-sub
201                                                                 ku))))
202                                    (f2cl-lib:int-add i 1))
203                                   ((> i
204                                       (min (the f2cl-lib:integer4 m)
205                                            (the f2cl-lib:integer4
206                                                 (f2cl-lib:int-add j kl))))
207                                    nil)
208                       (tagbody
209                         (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
210                                 (+
211                                  (f2cl-lib:fref y-%data%
212                                                 (iy)
213                                                 ((1 *))
214                                                 y-%offset%)
215                                  (* temp
216                                     (f2cl-lib:fref a-%data%
217                                                    ((f2cl-lib:int-add k i) j)
218                                                    ((1 lda) (1 *))
219                                                    a-%offset%))))
220                         (setf iy (f2cl-lib:int-add iy incy))
221                        label70))))
222                  (setf jx (f2cl-lib:int-add jx incx))
223                  (if (> j ku) (setf ky (f2cl-lib:int-add ky incy)))
224                 label80)))))
225          (t
226           (setf jy ky)
227           (cond
228             ((= incx 1)
229              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
230                            ((> j n) nil)
231                (tagbody
232                  (setf temp zero)
233                  (setf k (f2cl-lib:int-sub kup1 j))
234                  (f2cl-lib:fdo (i
235                                 (max (the f2cl-lib:integer4 1)
236                                      (the f2cl-lib:integer4
237                                           (f2cl-lib:int-add j
238                                                             (f2cl-lib:int-sub
239                                                              ku))))
240                                 (f2cl-lib:int-add i 1))
241                                ((> i
242                                    (min (the f2cl-lib:integer4 m)
243                                         (the f2cl-lib:integer4
244                                              (f2cl-lib:int-add j kl))))
245                                 nil)
246                    (tagbody
247                      (setf temp
248                              (+ temp
249                                 (*
250                                  (f2cl-lib:fref a-%data%
251                                                 ((f2cl-lib:int-add k i) j)
252                                                 ((1 lda) (1 *))
253                                                 a-%offset%)
254                                  (f2cl-lib:fref x-%data%
255                                                 (i)
256                                                 ((1 *))
257                                                 x-%offset%))))
258                     label90))
259                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
260                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
261                             (* alpha temp)))
262                  (setf jy (f2cl-lib:int-add jy incy))
263                 label100)))
264             (t
265              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
266                            ((> j n) nil)
267                (tagbody
268                  (setf temp zero)
269                  (setf ix kx)
270                  (setf k (f2cl-lib:int-sub kup1 j))
271                  (f2cl-lib:fdo (i
272                                 (max (the f2cl-lib:integer4 1)
273                                      (the f2cl-lib:integer4
274                                           (f2cl-lib:int-add j
275                                                             (f2cl-lib:int-sub
276                                                              ku))))
277                                 (f2cl-lib:int-add i 1))
278                                ((> i
279                                    (min (the f2cl-lib:integer4 m)
280                                         (the f2cl-lib:integer4
281                                              (f2cl-lib:int-add j kl))))
282                                 nil)
283                    (tagbody
284                      (setf temp
285                              (+ temp
286                                 (*
287                                  (f2cl-lib:fref a-%data%
288                                                 ((f2cl-lib:int-add k i) j)
289                                                 ((1 lda) (1 *))
290                                                 a-%offset%)
291                                  (f2cl-lib:fref x-%data%
292                                                 (ix)
293                                                 ((1 *))
294                                                 x-%offset%))))
295                      (setf ix (f2cl-lib:int-add ix incx))
296                     label110))
297                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
298                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
299                             (* alpha temp)))
300                  (setf jy (f2cl-lib:int-add jy incy))
301                  (if (> j ku) (setf kx (f2cl-lib:int-add kx incx)))
302                 label120))))))
303        (go end_label)
304       end_label
305        (return
306         (values nil nil nil nil nil nil nil nil nil nil nil nil nil))))))
307
308(in-package #-gcl #:cl-user #+gcl "CL-USER")
309#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
310(eval-when (:load-toplevel :compile-toplevel :execute)
311  (setf (gethash 'fortran-to-lisp::dgbmv fortran-to-lisp::*f2cl-function-info*)
312          (fortran-to-lisp::make-f2cl-finfo
313           :arg-types '((simple-string) (fortran-to-lisp::integer4)
314                        (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
315                        (fortran-to-lisp::integer4) (double-float)
316                        (array double-float (*)) (fortran-to-lisp::integer4)
317                        (array double-float (*)) (fortran-to-lisp::integer4)
318                        (double-float) (array double-float (*))
319                        (fortran-to-lisp::integer4))
320           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil
321                            nil)
322           :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
323
324