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(defun dscal (n da dx incx)
21  (declare (type (array double-float (*)) dx)
22           (type (double-float) da)
23           (type (f2cl-lib:integer4) incx n))
24  (f2cl-lib:with-multi-array-data
25      ((dx double-float dx-%data% dx-%offset%))
26    (prog ((i 0) (m 0) (mp1 0) (nincx 0))
27      (declare (type (f2cl-lib:integer4) nincx mp1 m i))
28      (if (or (<= n 0) (<= incx 0)) (go end_label))
29      (if (= incx 1) (go label20))
30      (setf nincx (f2cl-lib:int-mul n incx))
31      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i incx))
32                    ((> i nincx) nil)
33        (tagbody
34          (setf (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)
35                  (* da (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)))
36         label10))
37      (go end_label)
38     label20
39      (setf m (mod n 5))
40      (if (= m 0) (go label40))
41      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
42                    ((> i m) nil)
43        (tagbody
44          (setf (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)
45                  (* da (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)))
46         label30))
47      (if (< n 5) (go end_label))
48     label40
49      (setf mp1 (f2cl-lib:int-add m 1))
50      (f2cl-lib:fdo (i mp1 (f2cl-lib:int-add i 5))
51                    ((> i n) nil)
52        (tagbody
53          (setf (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)
54                  (* da (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)))
55          (setf (f2cl-lib:fref dx-%data%
56                               ((f2cl-lib:int-add i 1))
57                               ((1 *))
58                               dx-%offset%)
59                  (* da
60                     (f2cl-lib:fref dx-%data%
61                                    ((f2cl-lib:int-add i 1))
62                                    ((1 *))
63                                    dx-%offset%)))
64          (setf (f2cl-lib:fref dx-%data%
65                               ((f2cl-lib:int-add i 2))
66                               ((1 *))
67                               dx-%offset%)
68                  (* da
69                     (f2cl-lib:fref dx-%data%
70                                    ((f2cl-lib:int-add i 2))
71                                    ((1 *))
72                                    dx-%offset%)))
73          (setf (f2cl-lib:fref dx-%data%
74                               ((f2cl-lib:int-add i 3))
75                               ((1 *))
76                               dx-%offset%)
77                  (* da
78                     (f2cl-lib:fref dx-%data%
79                                    ((f2cl-lib:int-add i 3))
80                                    ((1 *))
81                                    dx-%offset%)))
82          (setf (f2cl-lib:fref dx-%data%
83                               ((f2cl-lib:int-add i 4))
84                               ((1 *))
85                               dx-%offset%)
86                  (* da
87                     (f2cl-lib:fref dx-%data%
88                                    ((f2cl-lib:int-add i 4))
89                                    ((1 *))
90                                    dx-%offset%)))
91         label50))
92      (go end_label)
93     end_label
94      (return (values nil nil nil nil)))))
95
96(in-package #-gcl #:cl-user #+gcl "CL-USER")
97#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
98(eval-when (:load-toplevel :compile-toplevel :execute)
99  (setf (gethash 'fortran-to-lisp::dscal fortran-to-lisp::*f2cl-function-info*)
100          (fortran-to-lisp::make-f2cl-finfo
101           :arg-types '((fortran-to-lisp::integer4) (double-float)
102                        (array double-float (*)) (fortran-to-lisp::integer4))
103           :return-values '(nil nil nil nil)
104           :calls 'nil)))
105
106