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