Add some basic letsimp tests based on bug #3950
[maxima.git] / share / lapack / blas / zgbmv.lisp
blob5e2ce54a383ac4e454d72aaef7d1e6d596c4efb5
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 $")
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))
17 (in-package :blas)
20 (let* ((one (f2cl-lib:cmplx 1.0 0.0)) (zero (f2cl-lib:cmplx 0.0 0.0)))
21 (declare (type (f2cl-lib:complex16) one)
22 (type (f2cl-lib:complex16) zero)
23 (ignorable one zero))
24 (defun zgbmv (trans m n kl ku alpha a lda x incx beta y incy)
25 (declare (type (array f2cl-lib:complex16 (*)) y x a)
26 (type (f2cl-lib:complex16) 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 f2cl-lib:complex16 a-%data% a-%offset%)
32 (x f2cl-lib:complex16 x-%data% x-%offset%)
33 (y f2cl-lib:complex16 y-%data% y-%offset%))
34 (prog ((noconj nil) (i 0) (info 0) (ix 0) (iy 0) (j 0) (jx 0) (jy 0)
35 (k 0) (kup1 0) (kx 0) (ky 0) (lenx 0) (leny 0) (temp #C(0.0 0.0)))
36 (declare (type f2cl-lib:logical noconj)
37 (type (f2cl-lib:integer4) i info ix iy j jx jy k kup1 kx ky
38 lenx leny)
39 (type (f2cl-lib:complex16) temp))
40 (setf info 0)
41 (cond
42 ((and (not (lsame trans "N"))
43 (not (lsame trans "T"))
44 (not (lsame trans "C")))
45 (setf info 1))
46 ((< m 0)
47 (setf info 2))
48 ((< n 0)
49 (setf info 3))
50 ((< kl 0)
51 (setf info 4))
52 ((< ku 0)
53 (setf info 5))
54 ((< lda (f2cl-lib:int-add kl ku 1))
55 (setf info 8))
56 ((= incx 0)
57 (setf info 10))
58 ((= incy 0)
59 (setf info 13)))
60 (cond
61 ((/= info 0)
62 (xerbla "ZGBMV " info)
63 (go end_label)))
64 (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one)))
65 (go end_label))
66 (setf noconj (lsame trans "T"))
67 (cond
68 ((lsame trans "N")
69 (setf lenx n)
70 (setf leny m))
72 (setf lenx m)
73 (setf leny n)))
74 (cond
75 ((> incx 0)
76 (setf kx 1))
78 (setf kx
79 (f2cl-lib:int-sub 1
80 (f2cl-lib:int-mul
81 (f2cl-lib:int-sub lenx 1)
82 incx)))))
83 (cond
84 ((> incy 0)
85 (setf ky 1))
87 (setf ky
88 (f2cl-lib:int-sub 1
89 (f2cl-lib:int-mul
90 (f2cl-lib:int-sub leny 1)
91 incy)))))
92 (cond
93 ((/= beta one)
94 (cond
95 ((= incy 1)
96 (cond
97 ((= beta zero)
98 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
99 ((> i leny) nil)
100 (tagbody
101 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
102 zero)
103 label10)))
105 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
106 ((> i leny) nil)
107 (tagbody
108 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
109 (* beta
110 (f2cl-lib:fref y-%data%
112 ((1 *))
113 y-%offset%)))
114 label20)))))
116 (setf iy ky)
117 (cond
118 ((= beta zero)
119 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
120 ((> i leny) nil)
121 (tagbody
122 (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
123 zero)
124 (setf iy (f2cl-lib:int-add iy incy))
125 label30)))
127 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
128 ((> i leny) nil)
129 (tagbody
130 (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
131 (* beta
132 (f2cl-lib:fref y-%data%
133 (iy)
134 ((1 *))
135 y-%offset%)))
136 (setf iy (f2cl-lib:int-add iy incy))
137 label40))))))))
138 (if (= alpha zero) (go end_label))
139 (setf kup1 (f2cl-lib:int-add ku 1))
140 (cond
141 ((lsame trans "N")
142 (setf jx kx)
143 (cond
144 ((= incy 1)
145 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
146 ((> j n) nil)
147 (tagbody
148 (cond
149 ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
150 (setf temp
151 (* alpha
152 (f2cl-lib:fref x-%data%
153 (jx)
154 ((1 *))
155 x-%offset%)))
156 (setf k (f2cl-lib:int-sub kup1 j))
157 (f2cl-lib:fdo (i
158 (max (the f2cl-lib:integer4 1)
159 (the f2cl-lib:integer4
160 (f2cl-lib:int-add j
161 (f2cl-lib:int-sub
162 ku))))
163 (f2cl-lib:int-add i 1))
164 ((> i
165 (min (the f2cl-lib:integer4 m)
166 (the f2cl-lib:integer4
167 (f2cl-lib:int-add j kl))))
168 nil)
169 (tagbody
170 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
172 (f2cl-lib:fref y-%data%
174 ((1 *))
175 y-%offset%)
176 (* temp
177 (f2cl-lib:fref a-%data%
178 ((f2cl-lib:int-add k i) j)
179 ((1 lda) (1 *))
180 a-%offset%))))
181 label50))))
182 (setf jx (f2cl-lib:int-add jx incx))
183 label60)))
185 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
186 ((> j n) nil)
187 (tagbody
188 (cond
189 ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
190 (setf temp
191 (* alpha
192 (f2cl-lib:fref x-%data%
193 (jx)
194 ((1 *))
195 x-%offset%)))
196 (setf iy ky)
197 (setf k (f2cl-lib:int-sub kup1 j))
198 (f2cl-lib:fdo (i
199 (max (the f2cl-lib:integer4 1)
200 (the f2cl-lib:integer4
201 (f2cl-lib:int-add j
202 (f2cl-lib:int-sub
203 ku))))
204 (f2cl-lib:int-add i 1))
205 ((> i
206 (min (the f2cl-lib:integer4 m)
207 (the f2cl-lib:integer4
208 (f2cl-lib:int-add j kl))))
209 nil)
210 (tagbody
211 (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
213 (f2cl-lib:fref y-%data%
214 (iy)
215 ((1 *))
216 y-%offset%)
217 (* temp
218 (f2cl-lib:fref a-%data%
219 ((f2cl-lib:int-add k i) j)
220 ((1 lda) (1 *))
221 a-%offset%))))
222 (setf iy (f2cl-lib:int-add iy incy))
223 label70))))
224 (setf jx (f2cl-lib:int-add jx incx))
225 (if (> j ku) (setf ky (f2cl-lib:int-add ky incy)))
226 label80)))))
228 (setf jy ky)
229 (cond
230 ((= incx 1)
231 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
232 ((> j n) nil)
233 (tagbody
234 (setf temp zero)
235 (setf k (f2cl-lib:int-sub kup1 j))
236 (cond
237 (noconj
238 (f2cl-lib:fdo (i
239 (max (the f2cl-lib:integer4 1)
240 (the f2cl-lib:integer4
241 (f2cl-lib:int-add j
242 (f2cl-lib:int-sub
243 ku))))
244 (f2cl-lib:int-add i 1))
245 ((> i
246 (min (the f2cl-lib:integer4 m)
247 (the f2cl-lib:integer4
248 (f2cl-lib:int-add j kl))))
249 nil)
250 (tagbody
251 (setf temp
252 (+ temp
254 (f2cl-lib:fref a-%data%
255 ((f2cl-lib:int-add k i) j)
256 ((1 lda) (1 *))
257 a-%offset%)
258 (f2cl-lib:fref x-%data%
260 ((1 *))
261 x-%offset%))))
262 label90)))
264 (f2cl-lib:fdo (i
265 (max (the f2cl-lib:integer4 1)
266 (the f2cl-lib:integer4
267 (f2cl-lib:int-add j
268 (f2cl-lib:int-sub
269 ku))))
270 (f2cl-lib:int-add i 1))
271 ((> i
272 (min (the f2cl-lib:integer4 m)
273 (the f2cl-lib:integer4
274 (f2cl-lib:int-add j kl))))
275 nil)
276 (tagbody
277 (setf temp
278 (+ temp
280 (f2cl-lib:dconjg
281 (f2cl-lib:fref a-%data%
282 ((f2cl-lib:int-add k i) j)
283 ((1 lda) (1 *))
284 a-%offset%))
285 (f2cl-lib:fref x-%data%
287 ((1 *))
288 x-%offset%))))
289 label100))))
290 (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
291 (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
292 (* alpha temp)))
293 (setf jy (f2cl-lib:int-add jy incy))
294 label110)))
296 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
297 ((> j n) nil)
298 (tagbody
299 (setf temp zero)
300 (setf ix kx)
301 (setf k (f2cl-lib:int-sub kup1 j))
302 (cond
303 (noconj
304 (f2cl-lib:fdo (i
305 (max (the f2cl-lib:integer4 1)
306 (the f2cl-lib:integer4
307 (f2cl-lib:int-add j
308 (f2cl-lib:int-sub
309 ku))))
310 (f2cl-lib:int-add i 1))
311 ((> i
312 (min (the f2cl-lib:integer4 m)
313 (the f2cl-lib:integer4
314 (f2cl-lib:int-add j kl))))
315 nil)
316 (tagbody
317 (setf temp
318 (+ temp
320 (f2cl-lib:fref a-%data%
321 ((f2cl-lib:int-add k i) j)
322 ((1 lda) (1 *))
323 a-%offset%)
324 (f2cl-lib:fref x-%data%
325 (ix)
326 ((1 *))
327 x-%offset%))))
328 (setf ix (f2cl-lib:int-add ix incx))
329 label120)))
331 (f2cl-lib:fdo (i
332 (max (the f2cl-lib:integer4 1)
333 (the f2cl-lib:integer4
334 (f2cl-lib:int-add j
335 (f2cl-lib:int-sub
336 ku))))
337 (f2cl-lib:int-add i 1))
338 ((> i
339 (min (the f2cl-lib:integer4 m)
340 (the f2cl-lib:integer4
341 (f2cl-lib:int-add j kl))))
342 nil)
343 (tagbody
344 (setf temp
345 (+ temp
347 (f2cl-lib:dconjg
348 (f2cl-lib:fref a-%data%
349 ((f2cl-lib:int-add k i) j)
350 ((1 lda) (1 *))
351 a-%offset%))
352 (f2cl-lib:fref x-%data%
353 (ix)
354 ((1 *))
355 x-%offset%))))
356 (setf ix (f2cl-lib:int-add ix incx))
357 label130))))
358 (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
359 (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
360 (* alpha temp)))
361 (setf jy (f2cl-lib:int-add jy incy))
362 (if (> j ku) (setf kx (f2cl-lib:int-add kx incx)))
363 label140))))))
364 (go end_label)
365 end_label
366 (return
367 (values nil nil nil nil nil nil nil nil nil nil nil nil nil))))))
369 (in-package #-gcl #:cl-user #+gcl "CL-USER")
370 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
371 (eval-when (:load-toplevel :compile-toplevel :execute)
372 (setf (gethash 'fortran-to-lisp::zgbmv fortran-to-lisp::*f2cl-function-info*)
373 (fortran-to-lisp::make-f2cl-finfo
374 :arg-types '((simple-string) (fortran-to-lisp::integer4)
375 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
376 (fortran-to-lisp::integer4)
377 (fortran-to-lisp::complex16)
378 (array fortran-to-lisp::complex16 (*))
379 (fortran-to-lisp::integer4)
380 (array fortran-to-lisp::complex16 (*))
381 (fortran-to-lisp::integer4)
382 (fortran-to-lisp::complex16)
383 (array fortran-to-lisp::complex16 (*))
384 (fortran-to-lisp::integer4))
385 :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil
386 nil)
387 :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))