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