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