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