share/lapack/blas/dgemv.lisp

   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 (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 dgemv (trans m n alpha a lda x incx beta y incy)
  25     (declare (type (array double-float (*)) y x a)
  26              (type (double-float) beta alpha)
  27              (type (f2cl-lib:integer4) incy incx lda n m)
  28              (type (simple-string *) trans))
  29     (f2cl-lib:with-multi-array-data
  30         ((trans character trans-%data% trans-%offset%)
  31          (a double-float a-%data% a-%offset%)
  32          (x double-float x-%data% x-%offset%)
  33          (y double-float y-%data% y-%offset%))
  34       (prog ((i 0) (info 0) (ix 0) (iy 0) (j 0) (jx 0) (jy 0) (kx 0) (ky 0)
  35              (lenx 0) (leny 0) (temp 0.0))
  36         (declare (type (f2cl-lib:integer4) i info ix iy j jx jy kx ky lenx
  37                                            leny)
  38                  (type (double-float) temp))
  39         (setf info 0)
  40         (cond
  41           ((and (not (lsame trans "N"))
  42                 (not (lsame trans "T"))
  43                 (not (lsame trans "C")))
  44            (setf info 1))
  45           ((< m 0)
  46            (setf info 2))
  47           ((< n 0)
  48            (setf info 3))
  49           ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m)))
  50            (setf info 6))
  51           ((= incx 0)
  52            (setf info 8))
  53           ((= incy 0)
  54            (setf info 11)))
  55         (cond
  56           ((/= info 0)
  57            (xerbla "DGEMV " info)
  58            (go end_label)))
  59         (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one)))
  60             (go end_label))
  61         (cond
  62           ((lsame trans "N")
  63            (setf lenx n)
  64            (setf leny m))
  65           (t
  66            (setf lenx m)
  67            (setf leny n)))
  68         (cond
  69           ((> incx 0)
  70            (setf kx 1))
  71           (t
  72            (setf kx
  73                    (f2cl-lib:int-sub 1
  74                                      (f2cl-lib:int-mul
  75                                       (f2cl-lib:int-sub lenx 1)
  76                                       incx)))))
  77         (cond
  78           ((> incy 0)
  79            (setf ky 1))
  80           (t
  81            (setf ky
  82                    (f2cl-lib:int-sub 1
  83                                      (f2cl-lib:int-mul
  84                                       (f2cl-lib:int-sub leny 1)
  85                                       incy)))))
  86         (cond
  87           ((/= beta one)
  88            (cond
  89              ((= incy 1)
  90               (cond
  91                 ((= beta zero)
  92                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  93                                ((> i leny) nil)
  94                    (tagbody
  95                      (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
  96                              zero)
  97                     label10)))
  98                 (t
  99                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 100                                ((> i leny) nil)
 101                    (tagbody
 102                      (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
 103                              (* beta
 104                                 (f2cl-lib:fref y-%data%
 105                                                (i)
 106                                                ((1 *))
 107                                                y-%offset%)))
 108                     label20)))))
 109              (t
 110               (setf iy ky)
 111               (cond
 112                 ((= beta zero)
 113                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 114                                ((> i leny) nil)
 115                    (tagbody
 116                      (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
 117                              zero)
 118                      (setf iy (f2cl-lib:int-add iy incy))
 119                     label30)))
 120                 (t
 121                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 122                                ((> i leny) nil)
 123                    (tagbody
 124                      (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
 125                              (* beta
 126                                 (f2cl-lib:fref y-%data%
 127                                                (iy)
 128                                                ((1 *))
 129                                                y-%offset%)))
 130                      (setf iy (f2cl-lib:int-add iy incy))
 131                     label40))))))))
 132         (if (= alpha zero) (go end_label))
 133         (cond
 134           ((lsame trans "N")
 135            (setf jx kx)
 136            (cond
 137              ((= incy 1)
 138               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 139                             ((> j n) nil)
 140                 (tagbody
 141                   (cond
 142                     ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
 143                      (setf temp
 144                              (* alpha
 145                                 (f2cl-lib:fref x-%data%
 146                                                (jx)
 147                                                ((1 *))
 148                                                x-%offset%)))
 149                      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 150                                    ((> i m) nil)
 151                        (tagbody
 152                          (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
 153                                  (+
 154                                   (f2cl-lib:fref y-%data%
 155                                                  (i)
 156                                                  ((1 *))
 157                                                  y-%offset%)
 158                                   (* temp
 159                                      (f2cl-lib:fref a-%data%
 160                                                     (i j)
 161                                                     ((1 lda) (1 *))
 162                                                     a-%offset%))))
 163                         label50))))
 164                   (setf jx (f2cl-lib:int-add jx incx))
 165                  label60)))
 166              (t
 167               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 168                             ((> j n) nil)
 169                 (tagbody
 170                   (cond
 171                     ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
 172                      (setf temp
 173                              (* alpha
 174                                 (f2cl-lib:fref x-%data%
 175                                                (jx)
 176                                                ((1 *))
 177                                                x-%offset%)))
 178                      (setf iy ky)
 179                      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 180                                    ((> i m) nil)
 181                        (tagbody
 182                          (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
 183                                  (+
 184                                   (f2cl-lib:fref y-%data%
 185                                                  (iy)
 186                                                  ((1 *))
 187                                                  y-%offset%)
 188                                   (* temp
 189                                      (f2cl-lib:fref a-%data%
 190                                                     (i j)
 191                                                     ((1 lda) (1 *))
 192                                                     a-%offset%))))
 193                          (setf iy (f2cl-lib:int-add iy incy))
 194                         label70))))
 195                   (setf jx (f2cl-lib:int-add jx incx))
 196                  label80)))))
 197           (t
 198            (setf jy ky)
 199            (cond
 200              ((= incx 1)
 201               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 202                             ((> j n) nil)
 203                 (tagbody
 204                   (setf temp zero)
 205                   (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 206                                 ((> i m) nil)
 207                     (tagbody
 208                       (setf temp
 209                               (+ temp
 210                                  (*
 211                                   (f2cl-lib:fref a-%data%
 212                                                  (i j)
 213                                                  ((1 lda) (1 *))
 214                                                  a-%offset%)
 215                                   (f2cl-lib:fref x-%data%
 216                                                  (i)
 217                                                  ((1 *))
 218                                                  x-%offset%))))
 219                      label90))
 220                   (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 221                           (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 222                              (* alpha temp)))
 223                   (setf jy (f2cl-lib:int-add jy incy))
 224                  label100)))
 225              (t
 226               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 227                             ((> j n) nil)
 228                 (tagbody
 229                   (setf temp zero)
 230                   (setf ix kx)
 231                   (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 232                                 ((> i m) nil)
 233                     (tagbody
 234                       (setf temp
 235                               (+ temp
 236                                  (*
 237                                   (f2cl-lib:fref a-%data%
 238                                                  (i j)
 239                                                  ((1 lda) (1 *))
 240                                                  a-%offset%)
 241                                   (f2cl-lib:fref x-%data%
 242                                                  (ix)
 243                                                  ((1 *))
 244                                                  x-%offset%))))
 245                       (setf ix (f2cl-lib:int-add ix incx))
 246                      label110))
 247                   (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 248                           (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 249                              (* alpha temp)))
 250                   (setf jy (f2cl-lib:int-add jy incy))
 251                  label120))))))
 252         (go end_label)
 253        end_label
 254         (return (values nil nil nil nil nil nil nil nil nil nil nil))))))
 255
 256 (in-package #-gcl #:cl-user #+gcl "CL-USER")
 257 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 258 (eval-when (:load-toplevel :compile-toplevel :execute)
 259   (setf (gethash 'fortran-to-lisp::dgemv fortran-to-lisp::*f2cl-function-info*)
 260           (fortran-to-lisp::make-f2cl-finfo
 261            :arg-types '((simple-string) (fortran-to-lisp::integer4)
 262                         (fortran-to-lisp::integer4) (double-float)
 263                         (array double-float (*)) (fortran-to-lisp::integer4)
 264                         (array double-float (*)) (fortran-to-lisp::integer4)
 265                         (double-float) (array double-float (*))
 266                         (fortran-to-lisp::integer4))
 267            :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
 268            :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
 269