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)
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))
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
)
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"))
47 (setf nounit
(lsame diag
"N"))
48 (setf upper
(lsame uplo
"U"))
51 ((and (not lside
) (not (lsame side
"R")))
53 ((and (not upper
) (not (lsame uplo
"L")))
55 ((and (not (lsame transa
"N"))
56 (not (lsame transa
"T"))
57 (not (lsame transa
"C")))
59 ((and (not (lsame diag
"U")) (not (lsame diag
"N")))
65 ((< lda
(max (the f2cl-lib
:integer4
1) (the f2cl-lib
:integer4 nrowa
)))
67 ((< ldb$
(max (the f2cl-lib
:integer4
1) (the f2cl-lib
:integer4 m
)))
71 (xerbla "DTRSM " info
)
73 (if (= n
0) (go end_label
))
76 (f2cl-lib:fdo
(j 1 (f2cl-lib:int-add j
1))
79 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
82 (setf (f2cl-lib:fref b-%data%
96 (f2cl-lib:fdo
(j 1 (f2cl-lib:int-add j
1))
101 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
104 (setf (f2cl-lib:fref b-%data%
109 (f2cl-lib:fref b-%data%
115 (f2cl-lib:int-add k
(f2cl-lib:int-sub
1)))
119 ((/= (f2cl-lib:fref b
(k j
) ((1 ldb$
) (1 *))) zero
)
121 (setf (f2cl-lib:fref b-%data%
126 (f2cl-lib:fref b-%data%
130 (f2cl-lib:fref a-%data%
134 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
141 (setf (f2cl-lib:fref b-%data%
146 (f2cl-lib:fref b-%data%
151 (f2cl-lib:fref b-%data%
155 (f2cl-lib:fref a-%data%
163 (f2cl-lib:fdo
(j 1 (f2cl-lib:int-add j
1))
168 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
171 (setf (f2cl-lib:fref b-%data%
176 (f2cl-lib:fref b-%data%
181 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
185 ((/= (f2cl-lib:fref b
(k j
) ((1 ldb$
) (1 *))) zero
)
187 (setf (f2cl-lib:fref b-%data%
192 (f2cl-lib:fref b-%data%
196 (f2cl-lib:fref a-%data%
200 (f2cl-lib:fdo
(i (f2cl-lib:int-add k
1)
201 (f2cl-lib:int-add i
1))
204 (setf (f2cl-lib:fref b-%data%
209 (f2cl-lib:fref b-%data%
214 (f2cl-lib:fref b-%data%
218 (f2cl-lib:fref a-%data%
228 (f2cl-lib:fdo
(j 1 (f2cl-lib:int-add j
1))
231 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
236 (f2cl-lib:fref b-%data%
240 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
250 (f2cl-lib:fref a-%data%
254 (f2cl-lib:fref b-%data%
262 (f2cl-lib:fref a-%data%
266 (setf (f2cl-lib:fref b-%data%
274 (f2cl-lib:fdo
(j 1 (f2cl-lib:int-add j
1))
278 (f2cl-lib:int-add i
(f2cl-lib:int-sub
1)))
283 (f2cl-lib:fref b-%data%
287 (f2cl-lib:fdo
(k (f2cl-lib:int-add i
1)
288 (f2cl-lib:int-add k
1))
294 (f2cl-lib:fref a-%data%
298 (f2cl-lib:fref b-%data%
306 (f2cl-lib:fref a-%data%
310 (setf (f2cl-lib:fref b-%data%
322 (f2cl-lib:fdo
(j 1 (f2cl-lib:int-add j
1))
327 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
330 (setf (f2cl-lib:fref b-%data%
335 (f2cl-lib:fref b-%data%
340 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
343 (f2cl-lib:int-sub
1)))
347 ((/= (f2cl-lib:fref a
(k j
) ((1 lda
) (1 *))) zero
)
348 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
351 (setf (f2cl-lib:fref b-%data%
356 (f2cl-lib:fref b-%data%
361 (f2cl-lib:fref a-%data%
365 (f2cl-lib:fref b-%data%
375 (f2cl-lib:fref a-%data%
379 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
382 (setf (f2cl-lib:fref b-%data%
387 (f2cl-lib:fref b-%data%
394 (f2cl-lib:fdo
(j n
(f2cl-lib:int-add j
(f2cl-lib:int-sub
1)))
399 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
402 (setf (f2cl-lib:fref b-%data%
407 (f2cl-lib:fref b-%data%
412 (f2cl-lib:fdo
(k (f2cl-lib:int-add j
1)
413 (f2cl-lib:int-add k
1))
417 ((/= (f2cl-lib:fref a
(k j
) ((1 lda
) (1 *))) zero
)
418 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
421 (setf (f2cl-lib:fref b-%data%
426 (f2cl-lib:fref b-%data%
431 (f2cl-lib:fref a-%data%
435 (f2cl-lib:fref b-%data%
445 (f2cl-lib:fref a-%data%
449 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
452 (setf (f2cl-lib:fref b-%data%
457 (f2cl-lib:fref b-%data%
466 (f2cl-lib:fdo
(k n
(f2cl-lib:int-add k
(f2cl-lib:int-sub
1)))
473 (f2cl-lib:fref a-%data%
477 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
480 (setf (f2cl-lib:fref b-%data%
485 (f2cl-lib:fref b-%data%
490 (f2cl-lib:fdo
(j 1 (f2cl-lib:int-add j
1))
493 (f2cl-lib:int-sub
1)))
497 ((/= (f2cl-lib:fref a
(j k
) ((1 lda
) (1 *))) zero
)
499 (f2cl-lib:fref a-%data%
503 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
506 (setf (f2cl-lib:fref b-%data%
511 (f2cl-lib:fref b-%data%
516 (f2cl-lib:fref b-%data%
524 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
527 (setf (f2cl-lib:fref b-%data%
532 (f2cl-lib:fref b-%data%
539 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
546 (f2cl-lib:fref a-%data%
550 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
553 (setf (f2cl-lib:fref b-%data%
558 (f2cl-lib:fref b-%data%
563 (f2cl-lib:fdo
(j (f2cl-lib:int-add k
1)
564 (f2cl-lib:int-add j
1))
568 ((/= (f2cl-lib:fref a
(j k
) ((1 lda
) (1 *))) zero
)
570 (f2cl-lib:fref a-%data%
574 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
577 (setf (f2cl-lib:fref b-%data%
582 (f2cl-lib:fref b-%data%
587 (f2cl-lib:fref b-%data%
595 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
598 (setf (f2cl-lib:fref b-%data%
603 (f2cl-lib:fref b-%data%
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
))))