share/lapack/blas/dsyr2.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* ((zero 0.0))
  21   (declare (type (double-float 0.0 0.0) zero) (ignorable zero))
  22   (defun dsyr2 (uplo n alpha x incx y incy a lda)
  23     (declare (type (array double-float (*)) a y x)
  24              (type (double-float) alpha)
  25              (type (f2cl-lib:integer4) lda incy incx n)
  26              (type (simple-string *) uplo))
  27     (f2cl-lib:with-multi-array-data
  28         ((uplo character uplo-%data% uplo-%offset%)
  29          (x double-float x-%data% x-%offset%)
  30          (y double-float y-%data% y-%offset%)
  31          (a double-float a-%data% a-%offset%))
  32       (prog ((i 0) (info 0) (ix 0) (iy 0) (j 0) (jx 0) (jy 0) (kx 0) (ky 0)
  33              (temp1 0.0) (temp2 0.0))
  34         (declare (type (f2cl-lib:integer4) i info ix iy j jx jy kx ky)
  35                  (type (double-float) temp1 temp2))
  36         (setf info 0)
  37         (cond
  38           ((and (not (lsame uplo "U")) (not (lsame uplo "L")))
  39            (setf info 1))
  40           ((< n 0)
  41            (setf info 2))
  42           ((= incx 0)
  43            (setf info 5))
  44           ((= incy 0)
  45            (setf info 7))
  46           ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 n)))
  47            (setf info 9)))
  48         (cond
  49           ((/= info 0)
  50            (xerbla "DSYR2 " info)
  51            (go end_label)))
  52         (if (or (= n 0) (= alpha zero)) (go end_label))
  53         (cond
  54           ((or (/= incx 1) (/= incy 1))
  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
  62                                          (f2cl-lib:int-sub n 1)
  63                                          incx)))))
  64            (cond
  65              ((> incy 0)
  66               (setf ky 1))
  67              (t
  68               (setf ky
  69                       (f2cl-lib:int-sub 1
  70                                         (f2cl-lib:int-mul
  71                                          (f2cl-lib:int-sub n 1)
  72                                          incy)))))
  73            (setf jx kx)
  74            (setf jy ky)))
  75         (cond
  76           ((lsame uplo "U")
  77            (cond
  78              ((and (= incx 1) (= incy 1))
  79               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  80                             ((> j n) nil)
  81                 (tagbody
  82                   (cond
  83                     ((or (/= (f2cl-lib:fref x (j) ((1 *))) zero)
  84                          (/= (f2cl-lib:fref y (j) ((1 *))) zero))
  85                      (setf temp1
  86                              (* alpha
  87                                 (f2cl-lib:fref y-%data%
  88                                                (j)
  89                                                ((1 *))
  90                                                y-%offset%)))
  91                      (setf temp2
  92                              (* alpha
  93                                 (f2cl-lib:fref x-%data%
  94                                                (j)
  95                                                ((1 *))
  96                                                x-%offset%)))
  97                      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  98                                    ((> i j) nil)
  99                        (tagbody
 100                          (setf (f2cl-lib:fref a-%data%
 101                                               (i j)
 102                                               ((1 lda) (1 *))
 103                                               a-%offset%)
 104                                  (+
 105                                   (f2cl-lib:fref a-%data%
 106                                                  (i j)
 107                                                  ((1 lda) (1 *))
 108                                                  a-%offset%)
 109                                   (*
 110                                    (f2cl-lib:fref x-%data%
 111                                                   (i)
 112                                                   ((1 *))
 113                                                   x-%offset%)
 114                                    temp1)
 115                                   (*
 116                                    (f2cl-lib:fref y-%data%
 117                                                   (i)
 118                                                   ((1 *))
 119                                                   y-%offset%)
 120                                    temp2)))
 121                         label10))))
 122                  label20)))
 123              (t
 124               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 125                             ((> j n) nil)
 126                 (tagbody
 127                   (cond
 128                     ((or (/= (f2cl-lib:fref x (jx) ((1 *))) zero)
 129                          (/= (f2cl-lib:fref y (jy) ((1 *))) zero))
 130                      (setf temp1
 131                              (* alpha
 132                                 (f2cl-lib:fref y-%data%
 133                                                (jy)
 134                                                ((1 *))
 135                                                y-%offset%)))
 136                      (setf temp2
 137                              (* alpha
 138                                 (f2cl-lib:fref x-%data%
 139                                                (jx)
 140                                                ((1 *))
 141                                                x-%offset%)))
 142                      (setf ix kx)
 143                      (setf iy ky)
 144                      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 145                                    ((> i j) nil)
 146                        (tagbody
 147                          (setf (f2cl-lib:fref a-%data%
 148                                               (i j)
 149                                               ((1 lda) (1 *))
 150                                               a-%offset%)
 151                                  (+
 152                                   (f2cl-lib:fref a-%data%
 153                                                  (i j)
 154                                                  ((1 lda) (1 *))
 155                                                  a-%offset%)
 156                                   (*
 157                                    (f2cl-lib:fref x-%data%
 158                                                   (ix)
 159                                                   ((1 *))
 160                                                   x-%offset%)
 161                                    temp1)
 162                                   (*
 163                                    (f2cl-lib:fref y-%data%
 164                                                   (iy)
 165                                                   ((1 *))
 166                                                   y-%offset%)
 167                                    temp2)))
 168                          (setf ix (f2cl-lib:int-add ix incx))
 169                          (setf iy (f2cl-lib:int-add iy incy))
 170                         label30))))
 171                   (setf jx (f2cl-lib:int-add jx incx))
 172                   (setf jy (f2cl-lib:int-add jy incy))
 173                  label40)))))
 174           (t
 175            (cond
 176              ((and (= incx 1) (= incy 1))
 177               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 178                             ((> j n) nil)
 179                 (tagbody
 180                   (cond
 181                     ((or (/= (f2cl-lib:fref x (j) ((1 *))) zero)
 182                          (/= (f2cl-lib:fref y (j) ((1 *))) zero))
 183                      (setf temp1
 184                              (* alpha
 185                                 (f2cl-lib:fref y-%data%
 186                                                (j)
 187                                                ((1 *))
 188                                                y-%offset%)))
 189                      (setf temp2
 190                              (* alpha
 191                                 (f2cl-lib:fref x-%data%
 192                                                (j)
 193                                                ((1 *))
 194                                                x-%offset%)))
 195                      (f2cl-lib:fdo (i j (f2cl-lib:int-add i 1))
 196                                    ((> i n) nil)
 197                        (tagbody
 198                          (setf (f2cl-lib:fref a-%data%
 199                                               (i j)
 200                                               ((1 lda) (1 *))
 201                                               a-%offset%)
 202                                  (+
 203                                   (f2cl-lib:fref a-%data%
 204                                                  (i j)
 205                                                  ((1 lda) (1 *))
 206                                                  a-%offset%)
 207                                   (*
 208                                    (f2cl-lib:fref x-%data%
 209                                                   (i)
 210                                                   ((1 *))
 211                                                   x-%offset%)
 212                                    temp1)
 213                                   (*
 214                                    (f2cl-lib:fref y-%data%
 215                                                   (i)
 216                                                   ((1 *))
 217                                                   y-%offset%)
 218                                    temp2)))
 219                         label50))))
 220                  label60)))
 221              (t
 222               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 223                             ((> j n) nil)
 224                 (tagbody
 225                   (cond
 226                     ((or (/= (f2cl-lib:fref x (jx) ((1 *))) zero)
 227                          (/= (f2cl-lib:fref y (jy) ((1 *))) zero))
 228                      (setf temp1
 229                              (* alpha
 230                                 (f2cl-lib:fref y-%data%
 231                                                (jy)
 232                                                ((1 *))
 233                                                y-%offset%)))
 234                      (setf temp2
 235                              (* alpha
 236                                 (f2cl-lib:fref x-%data%
 237                                                (jx)
 238                                                ((1 *))
 239                                                x-%offset%)))
 240                      (setf ix jx)
 241                      (setf iy jy)
 242                      (f2cl-lib:fdo (i j (f2cl-lib:int-add i 1))
 243                                    ((> i n) nil)
 244                        (tagbody
 245                          (setf (f2cl-lib:fref a-%data%
 246                                               (i j)
 247                                               ((1 lda) (1 *))
 248                                               a-%offset%)
 249                                  (+
 250                                   (f2cl-lib:fref a-%data%
 251                                                  (i j)
 252                                                  ((1 lda) (1 *))
 253                                                  a-%offset%)
 254                                   (*
 255                                    (f2cl-lib:fref x-%data%
 256                                                   (ix)
 257                                                   ((1 *))
 258                                                   x-%offset%)
 259                                    temp1)
 260                                   (*
 261                                    (f2cl-lib:fref y-%data%
 262                                                   (iy)
 263                                                   ((1 *))
 264                                                   y-%offset%)
 265                                    temp2)))
 266                          (setf ix (f2cl-lib:int-add ix incx))
 267                          (setf iy (f2cl-lib:int-add iy incy))
 268                         label70))))
 269                   (setf jx (f2cl-lib:int-add jx incx))
 270                   (setf jy (f2cl-lib:int-add jy incy))
 271                  label80))))))
 272         (go end_label)
 273        end_label
 274         (return (values nil nil nil nil nil nil nil nil nil))))))
 275
 276 (in-package #:cl-user)
 277 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 278 (eval-when (:load-toplevel :compile-toplevel :execute)
 279   (setf (gethash 'fortran-to-lisp::dsyr2 fortran-to-lisp::*f2cl-function-info*)
 280           (fortran-to-lisp::make-f2cl-finfo
 281            :arg-types '((simple-string) (fortran-to-lisp::integer4)
 282                         (double-float) (array double-float (*))
 283                         (fortran-to-lisp::integer4) (array double-float (*))
 284                         (fortran-to-lisp::integer4) (array double-float (*))
 285                         (fortran-to-lisp::integer4))
 286            :return-values '(nil nil nil nil nil nil nil nil nil)
 287            :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
 288