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