Add some basic letsimp tests based on bug #3950
[maxima.git] / share / lapack / blas / ztrsm.lisp
blob09ae93550dff173c1ec1d4e208a53029adfc6a20
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 ztrsm (side uplo transa diag m n alpha a lda b ldb$)
25 (declare (type (array f2cl-lib:complex16 (*)) b a)
26 (type (f2cl-lib:complex16) alpha)
27 (type (f2cl-lib:integer4) ldb$ lda n m)
28 (type (simple-string *) diag transa uplo side))
29 (f2cl-lib:with-multi-array-data
30 ((side character side-%data% side-%offset%)
31 (uplo character uplo-%data% uplo-%offset%)
32 (transa character transa-%data% transa-%offset%)
33 (diag character diag-%data% diag-%offset%)
34 (a f2cl-lib:complex16 a-%data% a-%offset%)
35 (b f2cl-lib:complex16 b-%data% b-%offset%))
36 (prog ((temp #C(0.0 0.0)) (i 0) (info 0) (j 0) (k 0) (nrowa 0)
37 (lside nil) (noconj nil) (nounit nil) (upper nil))
38 (declare (type (f2cl-lib:complex16) temp)
39 (type (f2cl-lib:integer4) i info j k nrowa)
40 (type f2cl-lib:logical lside noconj nounit upper))
41 (setf lside (lsame side "L"))
42 (cond
43 (lside
44 (setf nrowa m))
46 (setf nrowa n)))
47 (setf noconj (lsame transa "T"))
48 (setf nounit (lsame diag "N"))
49 (setf upper (lsame uplo "U"))
50 (setf info 0)
51 (cond
52 ((and (not lside) (not (lsame side "R")))
53 (setf info 1))
54 ((and (not upper) (not (lsame uplo "L")))
55 (setf info 2))
56 ((and (not (lsame transa "N"))
57 (not (lsame transa "T"))
58 (not (lsame transa "C")))
59 (setf info 3))
60 ((and (not (lsame diag "U")) (not (lsame diag "N")))
61 (setf info 4))
62 ((< m 0)
63 (setf info 5))
64 ((< n 0)
65 (setf info 6))
66 ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 nrowa)))
67 (setf info 9))
68 ((< ldb$ (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m)))
69 (setf info 11)))
70 (cond
71 ((/= info 0)
72 (xerbla "ZTRSM " info)
73 (go end_label)))
74 (if (= n 0) (go end_label))
75 (cond
76 ((= alpha zero)
77 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
78 ((> j n) nil)
79 (tagbody
80 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
81 ((> i m) nil)
82 (tagbody
83 (setf (f2cl-lib:fref b-%data%
84 (i j)
85 ((1 ldb$) (1 *))
86 b-%offset%)
87 zero)
88 label10))
89 label20))
90 (go end_label)))
91 (cond
92 (lside
93 (cond
94 ((lsame transa "N")
95 (cond
96 (upper
97 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
98 ((> j n) nil)
99 (tagbody
100 (cond
101 ((/= alpha one)
102 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
103 ((> i m) nil)
104 (tagbody
105 (setf (f2cl-lib:fref b-%data%
106 (i j)
107 ((1 ldb$) (1 *))
108 b-%offset%)
109 (* alpha
110 (f2cl-lib:fref b-%data%
111 (i j)
112 ((1 ldb$) (1 *))
113 b-%offset%)))
114 label30))))
115 (f2cl-lib:fdo (k m
116 (f2cl-lib:int-add k (f2cl-lib:int-sub 1)))
117 ((> k 1) nil)
118 (tagbody
119 (cond
120 ((/= (f2cl-lib:fref b (k j) ((1 ldb$) (1 *))) zero)
121 (if nounit
122 (setf (f2cl-lib:fref b-%data%
123 (k j)
124 ((1 ldb$) (1 *))
125 b-%offset%)
127 (f2cl-lib:fref b-%data%
128 (k j)
129 ((1 ldb$) (1 *))
130 b-%offset%)
131 (f2cl-lib:fref a-%data%
132 (k k)
133 ((1 lda) (1 *))
134 a-%offset%))))
135 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
136 ((> i
137 (f2cl-lib:int-add k
138 (f2cl-lib:int-sub
139 1)))
140 nil)
141 (tagbody
142 (setf (f2cl-lib:fref b-%data%
143 (i j)
144 ((1 ldb$) (1 *))
145 b-%offset%)
147 (f2cl-lib:fref b-%data%
148 (i j)
149 ((1 ldb$) (1 *))
150 b-%offset%)
152 (f2cl-lib:fref b-%data%
153 (k j)
154 ((1 ldb$) (1 *))
155 b-%offset%)
156 (f2cl-lib:fref a-%data%
157 (i k)
158 ((1 lda) (1 *))
159 a-%offset%))))
160 label40))))
161 label50))
162 label60)))
164 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
165 ((> j n) nil)
166 (tagbody
167 (cond
168 ((/= alpha one)
169 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
170 ((> i m) nil)
171 (tagbody
172 (setf (f2cl-lib:fref b-%data%
173 (i j)
174 ((1 ldb$) (1 *))
175 b-%offset%)
176 (* alpha
177 (f2cl-lib:fref b-%data%
178 (i j)
179 ((1 ldb$) (1 *))
180 b-%offset%)))
181 label70))))
182 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
183 ((> k m) nil)
184 (tagbody
185 (cond
186 ((/= (f2cl-lib:fref b (k j) ((1 ldb$) (1 *))) zero)
187 (if nounit
188 (setf (f2cl-lib:fref b-%data%
189 (k j)
190 ((1 ldb$) (1 *))
191 b-%offset%)
193 (f2cl-lib:fref b-%data%
194 (k j)
195 ((1 ldb$) (1 *))
196 b-%offset%)
197 (f2cl-lib:fref a-%data%
198 (k k)
199 ((1 lda) (1 *))
200 a-%offset%))))
201 (f2cl-lib:fdo (i (f2cl-lib:int-add k 1)
202 (f2cl-lib:int-add i 1))
203 ((> i m) nil)
204 (tagbody
205 (setf (f2cl-lib:fref b-%data%
206 (i j)
207 ((1 ldb$) (1 *))
208 b-%offset%)
210 (f2cl-lib:fref b-%data%
211 (i j)
212 ((1 ldb$) (1 *))
213 b-%offset%)
215 (f2cl-lib:fref b-%data%
216 (k j)
217 ((1 ldb$) (1 *))
218 b-%offset%)
219 (f2cl-lib:fref a-%data%
220 (i k)
221 ((1 lda) (1 *))
222 a-%offset%))))
223 label80))))
224 label90))
225 label100)))))
227 (cond
228 (upper
229 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
230 ((> j n) nil)
231 (tagbody
232 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
233 ((> i m) nil)
234 (tagbody
235 (setf temp
236 (* alpha
237 (f2cl-lib:fref b-%data%
238 (i j)
239 ((1 ldb$) (1 *))
240 b-%offset%)))
241 (cond
242 (noconj
243 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
244 ((> k
245 (f2cl-lib:int-add i
246 (f2cl-lib:int-sub
247 1)))
248 nil)
249 (tagbody
250 (setf temp
251 (- temp
253 (f2cl-lib:fref a-%data%
254 (k i)
255 ((1 lda) (1 *))
256 a-%offset%)
257 (f2cl-lib:fref b-%data%
258 (k j)
259 ((1 ldb$) (1 *))
260 b-%offset%))))
261 label110))
262 (if nounit
263 (setf temp
264 (/ temp
265 (f2cl-lib:fref a-%data%
266 (i i)
267 ((1 lda) (1 *))
268 a-%offset%)))))
270 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
271 ((> k
272 (f2cl-lib:int-add i
273 (f2cl-lib:int-sub
274 1)))
275 nil)
276 (tagbody
277 (setf temp
278 (- temp
280 (f2cl-lib:dconjg
281 (f2cl-lib:fref a-%data%
282 (k i)
283 ((1 lda) (1 *))
284 a-%offset%))
285 (f2cl-lib:fref b-%data%
286 (k j)
287 ((1 ldb$) (1 *))
288 b-%offset%))))
289 label120))
290 (if nounit
291 (setf temp
292 (/ temp
293 (f2cl-lib:dconjg
294 (f2cl-lib:fref a-%data%
295 (i i)
296 ((1 lda) (1 *))
297 a-%offset%)))))))
298 (setf (f2cl-lib:fref b-%data%
299 (i j)
300 ((1 ldb$) (1 *))
301 b-%offset%)
302 temp)
303 label130))
304 label140)))
306 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
307 ((> j n) nil)
308 (tagbody
309 (f2cl-lib:fdo (i m
310 (f2cl-lib:int-add i (f2cl-lib:int-sub 1)))
311 ((> i 1) nil)
312 (tagbody
313 (setf temp
314 (* alpha
315 (f2cl-lib:fref b-%data%
316 (i j)
317 ((1 ldb$) (1 *))
318 b-%offset%)))
319 (cond
320 (noconj
321 (f2cl-lib:fdo (k (f2cl-lib:int-add i 1)
322 (f2cl-lib:int-add k 1))
323 ((> k m) nil)
324 (tagbody
325 (setf temp
326 (- temp
328 (f2cl-lib:fref a-%data%
329 (k i)
330 ((1 lda) (1 *))
331 a-%offset%)
332 (f2cl-lib:fref b-%data%
333 (k j)
334 ((1 ldb$) (1 *))
335 b-%offset%))))
336 label150))
337 (if nounit
338 (setf temp
339 (/ temp
340 (f2cl-lib:fref a-%data%
341 (i i)
342 ((1 lda) (1 *))
343 a-%offset%)))))
345 (f2cl-lib:fdo (k (f2cl-lib:int-add i 1)
346 (f2cl-lib:int-add k 1))
347 ((> k m) nil)
348 (tagbody
349 (setf temp
350 (- temp
352 (f2cl-lib:dconjg
353 (f2cl-lib:fref a-%data%
354 (k i)
355 ((1 lda) (1 *))
356 a-%offset%))
357 (f2cl-lib:fref b-%data%
358 (k j)
359 ((1 ldb$) (1 *))
360 b-%offset%))))
361 label160))
362 (if nounit
363 (setf temp
364 (/ temp
365 (f2cl-lib:dconjg
366 (f2cl-lib:fref a-%data%
367 (i i)
368 ((1 lda) (1 *))
369 a-%offset%)))))))
370 (setf (f2cl-lib:fref b-%data%
371 (i j)
372 ((1 ldb$) (1 *))
373 b-%offset%)
374 temp)
375 label170))
376 label180)))))))
378 (cond
379 ((lsame transa "N")
380 (cond
381 (upper
382 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
383 ((> j n) nil)
384 (tagbody
385 (cond
386 ((/= alpha one)
387 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
388 ((> i m) nil)
389 (tagbody
390 (setf (f2cl-lib:fref b-%data%
391 (i j)
392 ((1 ldb$) (1 *))
393 b-%offset%)
394 (* alpha
395 (f2cl-lib:fref b-%data%
396 (i j)
397 ((1 ldb$) (1 *))
398 b-%offset%)))
399 label190))))
400 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
401 ((> k
402 (f2cl-lib:int-add j
403 (f2cl-lib:int-sub 1)))
404 nil)
405 (tagbody
406 (cond
407 ((/= (f2cl-lib:fref a (k j) ((1 lda) (1 *))) zero)
408 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
409 ((> i m) nil)
410 (tagbody
411 (setf (f2cl-lib:fref b-%data%
412 (i j)
413 ((1 ldb$) (1 *))
414 b-%offset%)
416 (f2cl-lib:fref b-%data%
417 (i j)
418 ((1 ldb$) (1 *))
419 b-%offset%)
421 (f2cl-lib:fref a-%data%
422 (k j)
423 ((1 lda) (1 *))
424 a-%offset%)
425 (f2cl-lib:fref b-%data%
426 (i k)
427 ((1 ldb$) (1 *))
428 b-%offset%))))
429 label200))))
430 label210))
431 (cond
432 (nounit
433 (setf temp
434 (/ one
435 (f2cl-lib:fref a-%data%
436 (j j)
437 ((1 lda) (1 *))
438 a-%offset%)))
439 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
440 ((> i m) nil)
441 (tagbody
442 (setf (f2cl-lib:fref b-%data%
443 (i j)
444 ((1 ldb$) (1 *))
445 b-%offset%)
446 (* temp
447 (f2cl-lib:fref b-%data%
448 (i j)
449 ((1 ldb$) (1 *))
450 b-%offset%)))
451 label220))))
452 label230)))
454 (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
455 ((> j 1) nil)
456 (tagbody
457 (cond
458 ((/= alpha one)
459 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
460 ((> i m) nil)
461 (tagbody
462 (setf (f2cl-lib:fref b-%data%
463 (i j)
464 ((1 ldb$) (1 *))
465 b-%offset%)
466 (* alpha
467 (f2cl-lib:fref b-%data%
468 (i j)
469 ((1 ldb$) (1 *))
470 b-%offset%)))
471 label240))))
472 (f2cl-lib:fdo (k (f2cl-lib:int-add j 1)
473 (f2cl-lib:int-add k 1))
474 ((> k n) nil)
475 (tagbody
476 (cond
477 ((/= (f2cl-lib:fref a (k j) ((1 lda) (1 *))) zero)
478 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
479 ((> i m) nil)
480 (tagbody
481 (setf (f2cl-lib:fref b-%data%
482 (i j)
483 ((1 ldb$) (1 *))
484 b-%offset%)
486 (f2cl-lib:fref b-%data%
487 (i j)
488 ((1 ldb$) (1 *))
489 b-%offset%)
491 (f2cl-lib:fref a-%data%
492 (k j)
493 ((1 lda) (1 *))
494 a-%offset%)
495 (f2cl-lib:fref b-%data%
496 (i k)
497 ((1 ldb$) (1 *))
498 b-%offset%))))
499 label250))))
500 label260))
501 (cond
502 (nounit
503 (setf temp
504 (/ one
505 (f2cl-lib:fref a-%data%
506 (j j)
507 ((1 lda) (1 *))
508 a-%offset%)))
509 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
510 ((> i m) nil)
511 (tagbody
512 (setf (f2cl-lib:fref b-%data%
513 (i j)
514 ((1 ldb$) (1 *))
515 b-%offset%)
516 (* temp
517 (f2cl-lib:fref b-%data%
518 (i j)
519 ((1 ldb$) (1 *))
520 b-%offset%)))
521 label270))))
522 label280)))))
524 (cond
525 (upper
526 (f2cl-lib:fdo (k n (f2cl-lib:int-add k (f2cl-lib:int-sub 1)))
527 ((> k 1) nil)
528 (tagbody
529 (cond
530 (nounit
531 (cond
532 (noconj
533 (setf temp
534 (/ one
535 (f2cl-lib:fref a-%data%
536 (k k)
537 ((1 lda) (1 *))
538 a-%offset%))))
540 (setf temp
541 (/ one
542 (f2cl-lib:dconjg
543 (f2cl-lib:fref a-%data%
544 (k k)
545 ((1 lda) (1 *))
546 a-%offset%))))))
547 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
548 ((> i m) nil)
549 (tagbody
550 (setf (f2cl-lib:fref b-%data%
551 (i k)
552 ((1 ldb$) (1 *))
553 b-%offset%)
554 (* temp
555 (f2cl-lib:fref b-%data%
556 (i k)
557 ((1 ldb$) (1 *))
558 b-%offset%)))
559 label290))))
560 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
561 ((> j
562 (f2cl-lib:int-add k
563 (f2cl-lib:int-sub 1)))
564 nil)
565 (tagbody
566 (cond
567 ((/= (f2cl-lib:fref a (j k) ((1 lda) (1 *))) zero)
568 (cond
569 (noconj
570 (setf temp
571 (f2cl-lib:fref a-%data%
572 (j k)
573 ((1 lda) (1 *))
574 a-%offset%)))
576 (setf temp
577 (coerce
578 (f2cl-lib:dconjg
579 (f2cl-lib:fref a-%data%
580 (j k)
581 ((1 lda) (1 *))
582 a-%offset%))
583 'f2cl-lib:complex16))))
584 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
585 ((> i m) nil)
586 (tagbody
587 (setf (f2cl-lib:fref b-%data%
588 (i j)
589 ((1 ldb$) (1 *))
590 b-%offset%)
592 (f2cl-lib:fref b-%data%
593 (i j)
594 ((1 ldb$) (1 *))
595 b-%offset%)
596 (* temp
597 (f2cl-lib:fref b-%data%
598 (i k)
599 ((1 ldb$) (1 *))
600 b-%offset%))))
601 label300))))
602 label310))
603 (cond
604 ((/= alpha one)
605 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
606 ((> i m) nil)
607 (tagbody
608 (setf (f2cl-lib:fref b-%data%
609 (i k)
610 ((1 ldb$) (1 *))
611 b-%offset%)
612 (* alpha
613 (f2cl-lib:fref b-%data%
614 (i k)
615 ((1 ldb$) (1 *))
616 b-%offset%)))
617 label320))))
618 label330)))
620 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
621 ((> k n) nil)
622 (tagbody
623 (cond
624 (nounit
625 (cond
626 (noconj
627 (setf temp
628 (/ one
629 (f2cl-lib:fref a-%data%
630 (k k)
631 ((1 lda) (1 *))
632 a-%offset%))))
634 (setf temp
635 (/ one
636 (f2cl-lib:dconjg
637 (f2cl-lib:fref a-%data%
638 (k k)
639 ((1 lda) (1 *))
640 a-%offset%))))))
641 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
642 ((> i m) nil)
643 (tagbody
644 (setf (f2cl-lib:fref b-%data%
645 (i k)
646 ((1 ldb$) (1 *))
647 b-%offset%)
648 (* temp
649 (f2cl-lib:fref b-%data%
650 (i k)
651 ((1 ldb$) (1 *))
652 b-%offset%)))
653 label340))))
654 (f2cl-lib:fdo (j (f2cl-lib:int-add k 1)
655 (f2cl-lib:int-add j 1))
656 ((> j n) nil)
657 (tagbody
658 (cond
659 ((/= (f2cl-lib:fref a (j k) ((1 lda) (1 *))) zero)
660 (cond
661 (noconj
662 (setf temp
663 (f2cl-lib:fref a-%data%
664 (j k)
665 ((1 lda) (1 *))
666 a-%offset%)))
668 (setf temp
669 (coerce
670 (f2cl-lib:dconjg
671 (f2cl-lib:fref a-%data%
672 (j k)
673 ((1 lda) (1 *))
674 a-%offset%))
675 'f2cl-lib:complex16))))
676 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
677 ((> i m) nil)
678 (tagbody
679 (setf (f2cl-lib:fref b-%data%
680 (i j)
681 ((1 ldb$) (1 *))
682 b-%offset%)
684 (f2cl-lib:fref b-%data%
685 (i j)
686 ((1 ldb$) (1 *))
687 b-%offset%)
688 (* temp
689 (f2cl-lib:fref b-%data%
690 (i k)
691 ((1 ldb$) (1 *))
692 b-%offset%))))
693 label350))))
694 label360))
695 (cond
696 ((/= alpha one)
697 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
698 ((> i m) nil)
699 (tagbody
700 (setf (f2cl-lib:fref b-%data%
701 (i k)
702 ((1 ldb$) (1 *))
703 b-%offset%)
704 (* alpha
705 (f2cl-lib:fref b-%data%
706 (i k)
707 ((1 ldb$) (1 *))
708 b-%offset%)))
709 label370))))
710 label380))))))))
711 (go end_label)
712 end_label
713 (return (values nil nil nil nil nil nil nil nil nil nil nil))))))
715 (in-package #-gcl #:cl-user #+gcl "CL-USER")
716 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
717 (eval-when (:load-toplevel :compile-toplevel :execute)
718 (setf (gethash 'fortran-to-lisp::ztrsm fortran-to-lisp::*f2cl-function-info*)
719 (fortran-to-lisp::make-f2cl-finfo
720 :arg-types '((simple-string) (simple-string) (simple-string)
721 (simple-string) (fortran-to-lisp::integer4)
722 (fortran-to-lisp::integer4)
723 (fortran-to-lisp::complex16)
724 (array fortran-to-lisp::complex16 (*))
725 (fortran-to-lisp::integer4)
726 (array fortran-to-lisp::complex16 (*))
727 (fortran-to-lisp::integer4))
728 :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
729 :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))