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