share/lapack/blas/dsbmv.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 dsbmv (uplo n k alpha a lda x incx beta y incy)
  25     (declare (type (array double-float (*)) y x a)
  26              (type (double-float) 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 double-float a-%data% a-%offset%)
  32          (x double-float x-%data% x-%offset%)
  33          (y double-float 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 0.0) (temp2 0.0))
  36         (declare (type (f2cl-lib:integer4) i info ix iy j jx jy kplus1 kx ky l)
  37                  (type (double-float) 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 "DSBMV " 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:fref a-%data%
 156                                                  ((f2cl-lib:int-add l i) j)
 157                                                  ((1 lda) (1 *))
 158                                                  a-%offset%)
 159                                   (f2cl-lib:fref x-%data%
 160                                                  (i)
 161                                                  ((1 *))
 162                                                  x-%offset%))))
 163                      label50))
 164                   (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 165                           (+ (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 166                              (* temp1
 167                                 (f2cl-lib:fref a-%data%
 168                                                (kplus1 j)
 169                                                ((1 lda) (1 *))
 170                                                a-%offset%))
 171                              (* alpha temp2)))
 172                  label60)))
 173              (t
 174               (setf jx kx)
 175               (setf jy ky)
 176               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 177                             ((> j n) nil)
 178                 (tagbody
 179                   (setf temp1
 180                           (* alpha
 181                              (f2cl-lib:fref x-%data% (jx) ((1 *)) x-%offset%)))
 182                   (setf temp2 zero)
 183                   (setf ix kx)
 184                   (setf iy ky)
 185                   (setf l (f2cl-lib:int-sub kplus1 j))
 186                   (f2cl-lib:fdo (i
 187                                  (max (the f2cl-lib:integer4 1)
 188                                       (the f2cl-lib:integer4
 189                                            (f2cl-lib:int-add j
 190                                                              (f2cl-lib:int-sub
 191                                                               k))))
 192                                  (f2cl-lib:int-add i 1))
 193                                 ((> i
 194                                     (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
 195                                  nil)
 196                     (tagbody
 197                       (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
 198                               (+
 199                                (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
 200                                (* temp1
 201                                   (f2cl-lib:fref a-%data%
 202                                                  ((f2cl-lib:int-add l i) j)
 203                                                  ((1 lda) (1 *))
 204                                                  a-%offset%))))
 205                       (setf temp2
 206                               (+ temp2
 207                                  (*
 208                                   (f2cl-lib:fref a-%data%
 209                                                  ((f2cl-lib:int-add l i) j)
 210                                                  ((1 lda) (1 *))
 211                                                  a-%offset%)
 212                                   (f2cl-lib:fref x-%data%
 213                                                  (ix)
 214                                                  ((1 *))
 215                                                  x-%offset%))))
 216                       (setf ix (f2cl-lib:int-add ix incx))
 217                       (setf iy (f2cl-lib:int-add iy incy))
 218                      label70))
 219                   (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 220                           (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 221                              (* temp1
 222                                 (f2cl-lib:fref a-%data%
 223                                                (kplus1 j)
 224                                                ((1 lda) (1 *))
 225                                                a-%offset%))
 226                              (* alpha temp2)))
 227                   (setf jx (f2cl-lib:int-add jx incx))
 228                   (setf jy (f2cl-lib:int-add jy incy))
 229                   (cond
 230                     ((> j k)
 231                      (setf kx (f2cl-lib:int-add kx incx))
 232                      (setf ky (f2cl-lib:int-add ky incy))))
 233                  label80)))))
 234           (t
 235            (cond
 236              ((and (= incx 1) (= incy 1))
 237               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 238                             ((> j n) nil)
 239                 (tagbody
 240                   (setf temp1
 241                           (* alpha
 242                              (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%)))
 243                   (setf temp2 zero)
 244                   (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 245                           (+ (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 246                              (* temp1
 247                                 (f2cl-lib:fref a-%data%
 248                                                (1 j)
 249                                                ((1 lda) (1 *))
 250                                                a-%offset%))))
 251                   (setf l (f2cl-lib:int-sub 1 j))
 252                   (f2cl-lib:fdo (i (f2cl-lib:int-add j 1)
 253                                  (f2cl-lib:int-add i 1))
 254                                 ((> i
 255                                     (min (the f2cl-lib:integer4 n)
 256                                          (the f2cl-lib:integer4
 257                                               (f2cl-lib:int-add j k))))
 258                                  nil)
 259                     (tagbody
 260                       (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
 261                               (+
 262                                (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
 263                                (* temp1
 264                                   (f2cl-lib:fref a-%data%
 265                                                  ((f2cl-lib:int-add l i) j)
 266                                                  ((1 lda) (1 *))
 267                                                  a-%offset%))))
 268                       (setf temp2
 269                               (+ temp2
 270                                  (*
 271                                   (f2cl-lib:fref a-%data%
 272                                                  ((f2cl-lib:int-add l i) j)
 273                                                  ((1 lda) (1 *))
 274                                                  a-%offset%)
 275                                   (f2cl-lib:fref x-%data%
 276                                                  (i)
 277                                                  ((1 *))
 278                                                  x-%offset%))))
 279                      label90))
 280                   (setf (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 281                           (+ (f2cl-lib:fref y-%data% (j) ((1 *)) y-%offset%)
 282                              (* alpha temp2)))
 283                  label100)))
 284              (t
 285               (setf jx kx)
 286               (setf jy ky)
 287               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 288                             ((> j n) nil)
 289                 (tagbody
 290                   (setf temp1
 291                           (* alpha
 292                              (f2cl-lib:fref x-%data% (jx) ((1 *)) x-%offset%)))
 293                   (setf temp2 zero)
 294                   (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 295                           (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 296                              (* temp1
 297                                 (f2cl-lib:fref a-%data%
 298                                                (1 j)
 299                                                ((1 lda) (1 *))
 300                                                a-%offset%))))
 301                   (setf l (f2cl-lib:int-sub 1 j))
 302                   (setf ix jx)
 303                   (setf iy jy)
 304                   (f2cl-lib:fdo (i (f2cl-lib:int-add j 1)
 305                                  (f2cl-lib:int-add i 1))
 306                                 ((> i
 307                                     (min (the f2cl-lib:integer4 n)
 308                                          (the f2cl-lib:integer4
 309                                               (f2cl-lib:int-add j k))))
 310                                  nil)
 311                     (tagbody
 312                       (setf ix (f2cl-lib:int-add ix incx))
 313                       (setf iy (f2cl-lib:int-add iy incy))
 314                       (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
 315                               (+
 316                                (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
 317                                (* temp1
 318                                   (f2cl-lib:fref a-%data%
 319                                                  ((f2cl-lib:int-add l i) j)
 320                                                  ((1 lda) (1 *))
 321                                                  a-%offset%))))
 322                       (setf temp2
 323                               (+ temp2
 324                                  (*
 325                                   (f2cl-lib:fref a-%data%
 326                                                  ((f2cl-lib:int-add l i) j)
 327                                                  ((1 lda) (1 *))
 328                                                  a-%offset%)
 329                                   (f2cl-lib:fref x-%data%
 330                                                  (ix)
 331                                                  ((1 *))
 332                                                  x-%offset%))))
 333                      label110))
 334                   (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 335                           (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
 336                              (* alpha temp2)))
 337                   (setf jx (f2cl-lib:int-add jx incx))
 338                   (setf jy (f2cl-lib:int-add jy incy))
 339                  label120))))))
 340         (go end_label)
 341        end_label
 342         (return (values nil nil nil nil nil nil nil nil nil nil nil))))))
 343
 344 (in-package #-gcl #:cl-user #+gcl "CL-USER")
 345 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 346 (eval-when (:load-toplevel :compile-toplevel :execute)
 347   (setf (gethash 'fortran-to-lisp::dsbmv fortran-to-lisp::*f2cl-function-info*)
 348           (fortran-to-lisp::make-f2cl-finfo
 349            :arg-types '((simple-string) (fortran-to-lisp::integer4)
 350                         (fortran-to-lisp::integer4) (double-float)
 351                         (array double-float (*)) (fortran-to-lisp::integer4)
 352                         (array double-float (*)) (fortran-to-lisp::integer4)
 353                         (double-float) (array double-float (*))
 354                         (fortran-to-lisp::integer4))
 355            :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
 356            :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
 357