Windows installer: Update README.txt.
[maxima.git] / share / lapack / blas / dtrsm.lisp
blobae3c932a5086e0730142717560bd0bee184ce829
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 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 dtrsm (side uplo transa diag m n alpha a lda b ldb$)
25 (declare (type (array double-float (*)) b a)
26 (type (double-float) 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 double-float a-%data% a-%offset%)
35 (b double-float b-%data% b-%offset%))
36 (prog ((temp 0.0) (i 0) (info 0) (j 0) (k 0) (nrowa 0) (lside nil)
37 (nounit nil) (upper nil))
38 (declare (type (double-float) temp)
39 (type (f2cl-lib:integer4) i info j k nrowa)
40 (type f2cl-lib:logical lside nounit upper))
41 (setf lside (lsame side "L"))
42 (cond
43 (lside
44 (setf nrowa m))
46 (setf nrowa n)))
47 (setf nounit (lsame diag "N"))
48 (setf upper (lsame uplo "U"))
49 (setf info 0)
50 (cond
51 ((and (not lside) (not (lsame side "R")))
52 (setf info 1))
53 ((and (not upper) (not (lsame uplo "L")))
54 (setf info 2))
55 ((and (not (lsame transa "N"))
56 (not (lsame transa "T"))
57 (not (lsame transa "C")))
58 (setf info 3))
59 ((and (not (lsame diag "U")) (not (lsame diag "N")))
60 (setf info 4))
61 ((< m 0)
62 (setf info 5))
63 ((< n 0)
64 (setf info 6))
65 ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 nrowa)))
66 (setf info 9))
67 ((< ldb$ (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m)))
68 (setf info 11)))
69 (cond
70 ((/= info 0)
71 (xerbla "DTRSM " info)
72 (go end_label)))
73 (if (= n 0) (go end_label))
74 (cond
75 ((= alpha zero)
76 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
77 ((> j n) nil)
78 (tagbody
79 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
80 ((> i m) nil)
81 (tagbody
82 (setf (f2cl-lib:fref b-%data%
83 (i j)
84 ((1 ldb$) (1 *))
85 b-%offset%)
86 zero)
87 label10))
88 label20))
89 (go end_label)))
90 (cond
91 (lside
92 (cond
93 ((lsame transa "N")
94 (cond
95 (upper
96 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
97 ((> j n) nil)
98 (tagbody
99 (cond
100 ((/= alpha one)
101 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
102 ((> i m) nil)
103 (tagbody
104 (setf (f2cl-lib:fref b-%data%
105 (i j)
106 ((1 ldb$) (1 *))
107 b-%offset%)
108 (* alpha
109 (f2cl-lib:fref b-%data%
110 (i j)
111 ((1 ldb$) (1 *))
112 b-%offset%)))
113 label30))))
114 (f2cl-lib:fdo (k m
115 (f2cl-lib:int-add k (f2cl-lib:int-sub 1)))
116 ((> k 1) nil)
117 (tagbody
118 (cond
119 ((/= (f2cl-lib:fref b (k j) ((1 ldb$) (1 *))) zero)
120 (if nounit
121 (setf (f2cl-lib:fref b-%data%
122 (k j)
123 ((1 ldb$) (1 *))
124 b-%offset%)
126 (f2cl-lib:fref b-%data%
127 (k j)
128 ((1 ldb$) (1 *))
129 b-%offset%)
130 (f2cl-lib:fref a-%data%
131 (k k)
132 ((1 lda) (1 *))
133 a-%offset%))))
134 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
135 ((> i
136 (f2cl-lib:int-add k
137 (f2cl-lib:int-sub
138 1)))
139 nil)
140 (tagbody
141 (setf (f2cl-lib:fref b-%data%
142 (i j)
143 ((1 ldb$) (1 *))
144 b-%offset%)
146 (f2cl-lib:fref b-%data%
147 (i j)
148 ((1 ldb$) (1 *))
149 b-%offset%)
151 (f2cl-lib:fref b-%data%
152 (k j)
153 ((1 ldb$) (1 *))
154 b-%offset%)
155 (f2cl-lib:fref a-%data%
156 (i k)
157 ((1 lda) (1 *))
158 a-%offset%))))
159 label40))))
160 label50))
161 label60)))
163 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
164 ((> j n) nil)
165 (tagbody
166 (cond
167 ((/= alpha one)
168 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
169 ((> i m) nil)
170 (tagbody
171 (setf (f2cl-lib:fref b-%data%
172 (i j)
173 ((1 ldb$) (1 *))
174 b-%offset%)
175 (* alpha
176 (f2cl-lib:fref b-%data%
177 (i j)
178 ((1 ldb$) (1 *))
179 b-%offset%)))
180 label70))))
181 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
182 ((> k m) nil)
183 (tagbody
184 (cond
185 ((/= (f2cl-lib:fref b (k j) ((1 ldb$) (1 *))) zero)
186 (if nounit
187 (setf (f2cl-lib:fref b-%data%
188 (k j)
189 ((1 ldb$) (1 *))
190 b-%offset%)
192 (f2cl-lib:fref b-%data%
193 (k j)
194 ((1 ldb$) (1 *))
195 b-%offset%)
196 (f2cl-lib:fref a-%data%
197 (k k)
198 ((1 lda) (1 *))
199 a-%offset%))))
200 (f2cl-lib:fdo (i (f2cl-lib:int-add k 1)
201 (f2cl-lib:int-add i 1))
202 ((> i m) nil)
203 (tagbody
204 (setf (f2cl-lib:fref b-%data%
205 (i j)
206 ((1 ldb$) (1 *))
207 b-%offset%)
209 (f2cl-lib:fref b-%data%
210 (i j)
211 ((1 ldb$) (1 *))
212 b-%offset%)
214 (f2cl-lib:fref b-%data%
215 (k j)
216 ((1 ldb$) (1 *))
217 b-%offset%)
218 (f2cl-lib:fref a-%data%
219 (i k)
220 ((1 lda) (1 *))
221 a-%offset%))))
222 label80))))
223 label90))
224 label100)))))
226 (cond
227 (upper
228 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
229 ((> j n) nil)
230 (tagbody
231 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
232 ((> i m) nil)
233 (tagbody
234 (setf temp
235 (* alpha
236 (f2cl-lib:fref b-%data%
237 (i j)
238 ((1 ldb$) (1 *))
239 b-%offset%)))
240 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
241 ((> k
242 (f2cl-lib:int-add i
243 (f2cl-lib:int-sub
244 1)))
245 nil)
246 (tagbody
247 (setf temp
248 (- temp
250 (f2cl-lib:fref a-%data%
251 (k i)
252 ((1 lda) (1 *))
253 a-%offset%)
254 (f2cl-lib:fref b-%data%
255 (k j)
256 ((1 ldb$) (1 *))
257 b-%offset%))))
258 label110))
259 (if nounit
260 (setf temp
261 (/ temp
262 (f2cl-lib:fref a-%data%
263 (i i)
264 ((1 lda) (1 *))
265 a-%offset%))))
266 (setf (f2cl-lib:fref b-%data%
267 (i j)
268 ((1 ldb$) (1 *))
269 b-%offset%)
270 temp)
271 label120))
272 label130)))
274 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
275 ((> j n) nil)
276 (tagbody
277 (f2cl-lib:fdo (i m
278 (f2cl-lib:int-add i (f2cl-lib:int-sub 1)))
279 ((> i 1) nil)
280 (tagbody
281 (setf temp
282 (* alpha
283 (f2cl-lib:fref b-%data%
284 (i j)
285 ((1 ldb$) (1 *))
286 b-%offset%)))
287 (f2cl-lib:fdo (k (f2cl-lib:int-add i 1)
288 (f2cl-lib:int-add k 1))
289 ((> k m) nil)
290 (tagbody
291 (setf temp
292 (- temp
294 (f2cl-lib:fref a-%data%
295 (k i)
296 ((1 lda) (1 *))
297 a-%offset%)
298 (f2cl-lib:fref b-%data%
299 (k j)
300 ((1 ldb$) (1 *))
301 b-%offset%))))
302 label140))
303 (if nounit
304 (setf temp
305 (/ temp
306 (f2cl-lib:fref a-%data%
307 (i i)
308 ((1 lda) (1 *))
309 a-%offset%))))
310 (setf (f2cl-lib:fref b-%data%
311 (i j)
312 ((1 ldb$) (1 *))
313 b-%offset%)
314 temp)
315 label150))
316 label160)))))))
318 (cond
319 ((lsame transa "N")
320 (cond
321 (upper
322 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
323 ((> j n) nil)
324 (tagbody
325 (cond
326 ((/= alpha one)
327 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
328 ((> i m) nil)
329 (tagbody
330 (setf (f2cl-lib:fref b-%data%
331 (i j)
332 ((1 ldb$) (1 *))
333 b-%offset%)
334 (* alpha
335 (f2cl-lib:fref b-%data%
336 (i j)
337 ((1 ldb$) (1 *))
338 b-%offset%)))
339 label170))))
340 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
341 ((> k
342 (f2cl-lib:int-add j
343 (f2cl-lib:int-sub 1)))
344 nil)
345 (tagbody
346 (cond
347 ((/= (f2cl-lib:fref a (k j) ((1 lda) (1 *))) zero)
348 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
349 ((> i m) nil)
350 (tagbody
351 (setf (f2cl-lib:fref b-%data%
352 (i j)
353 ((1 ldb$) (1 *))
354 b-%offset%)
356 (f2cl-lib:fref b-%data%
357 (i j)
358 ((1 ldb$) (1 *))
359 b-%offset%)
361 (f2cl-lib:fref a-%data%
362 (k j)
363 ((1 lda) (1 *))
364 a-%offset%)
365 (f2cl-lib:fref b-%data%
366 (i k)
367 ((1 ldb$) (1 *))
368 b-%offset%))))
369 label180))))
370 label190))
371 (cond
372 (nounit
373 (setf temp
374 (/ one
375 (f2cl-lib:fref a-%data%
376 (j j)
377 ((1 lda) (1 *))
378 a-%offset%)))
379 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
380 ((> i m) nil)
381 (tagbody
382 (setf (f2cl-lib:fref b-%data%
383 (i j)
384 ((1 ldb$) (1 *))
385 b-%offset%)
386 (* temp
387 (f2cl-lib:fref b-%data%
388 (i j)
389 ((1 ldb$) (1 *))
390 b-%offset%)))
391 label200))))
392 label210)))
394 (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
395 ((> j 1) nil)
396 (tagbody
397 (cond
398 ((/= alpha one)
399 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
400 ((> i m) nil)
401 (tagbody
402 (setf (f2cl-lib:fref b-%data%
403 (i j)
404 ((1 ldb$) (1 *))
405 b-%offset%)
406 (* alpha
407 (f2cl-lib:fref b-%data%
408 (i j)
409 ((1 ldb$) (1 *))
410 b-%offset%)))
411 label220))))
412 (f2cl-lib:fdo (k (f2cl-lib:int-add j 1)
413 (f2cl-lib:int-add k 1))
414 ((> k n) nil)
415 (tagbody
416 (cond
417 ((/= (f2cl-lib:fref a (k j) ((1 lda) (1 *))) zero)
418 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
419 ((> i m) nil)
420 (tagbody
421 (setf (f2cl-lib:fref b-%data%
422 (i j)
423 ((1 ldb$) (1 *))
424 b-%offset%)
426 (f2cl-lib:fref b-%data%
427 (i j)
428 ((1 ldb$) (1 *))
429 b-%offset%)
431 (f2cl-lib:fref a-%data%
432 (k j)
433 ((1 lda) (1 *))
434 a-%offset%)
435 (f2cl-lib:fref b-%data%
436 (i k)
437 ((1 ldb$) (1 *))
438 b-%offset%))))
439 label230))))
440 label240))
441 (cond
442 (nounit
443 (setf temp
444 (/ one
445 (f2cl-lib:fref a-%data%
446 (j j)
447 ((1 lda) (1 *))
448 a-%offset%)))
449 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
450 ((> i m) nil)
451 (tagbody
452 (setf (f2cl-lib:fref b-%data%
453 (i j)
454 ((1 ldb$) (1 *))
455 b-%offset%)
456 (* temp
457 (f2cl-lib:fref b-%data%
458 (i j)
459 ((1 ldb$) (1 *))
460 b-%offset%)))
461 label250))))
462 label260)))))
464 (cond
465 (upper
466 (f2cl-lib:fdo (k n (f2cl-lib:int-add k (f2cl-lib:int-sub 1)))
467 ((> k 1) nil)
468 (tagbody
469 (cond
470 (nounit
471 (setf temp
472 (/ one
473 (f2cl-lib:fref a-%data%
474 (k k)
475 ((1 lda) (1 *))
476 a-%offset%)))
477 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
478 ((> i m) nil)
479 (tagbody
480 (setf (f2cl-lib:fref b-%data%
481 (i k)
482 ((1 ldb$) (1 *))
483 b-%offset%)
484 (* temp
485 (f2cl-lib:fref b-%data%
486 (i k)
487 ((1 ldb$) (1 *))
488 b-%offset%)))
489 label270))))
490 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
491 ((> j
492 (f2cl-lib:int-add k
493 (f2cl-lib:int-sub 1)))
494 nil)
495 (tagbody
496 (cond
497 ((/= (f2cl-lib:fref a (j k) ((1 lda) (1 *))) zero)
498 (setf temp
499 (f2cl-lib:fref a-%data%
500 (j k)
501 ((1 lda) (1 *))
502 a-%offset%))
503 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
504 ((> i m) nil)
505 (tagbody
506 (setf (f2cl-lib:fref b-%data%
507 (i j)
508 ((1 ldb$) (1 *))
509 b-%offset%)
511 (f2cl-lib:fref b-%data%
512 (i j)
513 ((1 ldb$) (1 *))
514 b-%offset%)
515 (* temp
516 (f2cl-lib:fref b-%data%
517 (i k)
518 ((1 ldb$) (1 *))
519 b-%offset%))))
520 label280))))
521 label290))
522 (cond
523 ((/= alpha one)
524 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
525 ((> i m) nil)
526 (tagbody
527 (setf (f2cl-lib:fref b-%data%
528 (i k)
529 ((1 ldb$) (1 *))
530 b-%offset%)
531 (* alpha
532 (f2cl-lib:fref b-%data%
533 (i k)
534 ((1 ldb$) (1 *))
535 b-%offset%)))
536 label300))))
537 label310)))
539 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
540 ((> k n) nil)
541 (tagbody
542 (cond
543 (nounit
544 (setf temp
545 (/ one
546 (f2cl-lib:fref a-%data%
547 (k k)
548 ((1 lda) (1 *))
549 a-%offset%)))
550 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
551 ((> i m) nil)
552 (tagbody
553 (setf (f2cl-lib:fref b-%data%
554 (i k)
555 ((1 ldb$) (1 *))
556 b-%offset%)
557 (* temp
558 (f2cl-lib:fref b-%data%
559 (i k)
560 ((1 ldb$) (1 *))
561 b-%offset%)))
562 label320))))
563 (f2cl-lib:fdo (j (f2cl-lib:int-add k 1)
564 (f2cl-lib:int-add j 1))
565 ((> j n) nil)
566 (tagbody
567 (cond
568 ((/= (f2cl-lib:fref a (j k) ((1 lda) (1 *))) zero)
569 (setf temp
570 (f2cl-lib:fref a-%data%
571 (j k)
572 ((1 lda) (1 *))
573 a-%offset%))
574 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
575 ((> i m) nil)
576 (tagbody
577 (setf (f2cl-lib:fref b-%data%
578 (i j)
579 ((1 ldb$) (1 *))
580 b-%offset%)
582 (f2cl-lib:fref b-%data%
583 (i j)
584 ((1 ldb$) (1 *))
585 b-%offset%)
586 (* temp
587 (f2cl-lib:fref b-%data%
588 (i k)
589 ((1 ldb$) (1 *))
590 b-%offset%))))
591 label330))))
592 label340))
593 (cond
594 ((/= alpha one)
595 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
596 ((> i m) nil)
597 (tagbody
598 (setf (f2cl-lib:fref b-%data%
599 (i k)
600 ((1 ldb$) (1 *))
601 b-%offset%)
602 (* alpha
603 (f2cl-lib:fref b-%data%
604 (i k)
605 ((1 ldb$) (1 *))
606 b-%offset%)))
607 label350))))
608 label360))))))))
609 (go end_label)
610 end_label
611 (return (values nil nil nil nil nil nil nil nil nil nil nil))))))
613 (in-package #:cl-user)
614 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
615 (eval-when (:load-toplevel :compile-toplevel :execute)
616 (setf (gethash 'fortran-to-lisp::dtrsm fortran-to-lisp::*f2cl-function-info*)
617 (fortran-to-lisp::make-f2cl-finfo
618 :arg-types '((simple-string) (simple-string) (simple-string)
619 (simple-string) (fortran-to-lisp::integer4)
620 (fortran-to-lisp::integer4) (double-float)
621 (array double-float (*)) (fortran-to-lisp::integer4)
622 (array double-float (*)) (fortran-to-lisp::integer4))
623 :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
624 :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))