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