share/lapack/blas/dtpmv.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 dtpmv (uplo trans diag n ap x incx)
  23     (declare (type (array double-float (*)) x ap)
  24              (type (f2cl-lib:integer4) incx n)
  25              (type (simple-string *) diag trans uplo))
  26     (f2cl-lib:with-multi-array-data
  27         ((uplo character uplo-%data% uplo-%offset%)
  28          (trans character trans-%data% trans-%offset%)
  29          (diag character diag-%data% diag-%offset%)
  30          (ap double-float ap-%data% ap-%offset%)
  31          (x double-float x-%data% x-%offset%))
  32       (prog ((nounit nil) (i 0) (info 0) (ix 0) (j 0) (jx 0) (k 0) (kk 0)
  33              (kx 0) (temp 0.0))
  34         (declare (type f2cl-lib:logical nounit)
  35                  (type (f2cl-lib:integer4) i info ix j jx k kk kx)
  36                  (type (double-float) temp))
  37         (setf info 0)
  38         (cond
  39           ((and (not (lsame uplo "U")) (not (lsame uplo "L")))
  40            (setf info 1))
  41           ((and (not (lsame trans "N"))
  42                 (not (lsame trans "T"))
  43                 (not (lsame trans "C")))
  44            (setf info 2))
  45           ((and (not (lsame diag "U")) (not (lsame diag "N")))
  46            (setf info 3))
  47           ((< n 0)
  48            (setf info 4))
  49           ((= incx 0)
  50            (setf info 7)))
  51         (cond
  52           ((/= info 0)
  53            (xerbla "DTPMV " info)
  54            (go end_label)))
  55         (if (= n 0) (go end_label))
  56         (setf nounit (lsame diag "N"))
  57         (cond
  58           ((<= incx 0)
  59            (setf kx
  60                    (f2cl-lib:int-sub 1
  61                                      (f2cl-lib:int-mul (f2cl-lib:int-sub n 1)
  62                                                        incx))))
  63           ((/= incx 1)
  64            (setf kx 1)))
  65         (cond
  66           ((lsame trans "N")
  67            (cond
  68              ((lsame uplo "U")
  69               (setf kk 1)
  70               (cond
  71                 ((= incx 1)
  72                  (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
  73                                ((> j n) nil)
  74                    (tagbody
  75                      (cond
  76                        ((/= (f2cl-lib:fref x (j) ((1 *))) zero)
  77                         (setf temp
  78                                 (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%))
  79                         (setf k kk)
  80                         (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  81                                       ((> i
  82                                           (f2cl-lib:int-add j
  83                                                             (f2cl-lib:int-sub
  84                                                              1)))
  85                                        nil)
  86                           (tagbody
  87                             (setf (f2cl-lib:fref x-%data%
  88                                                  (i)
  89                                                  ((1 *))
  90                                                  x-%offset%)
  91                                     (+
  92                                      (f2cl-lib:fref x-%data%
  93                                                     (i)
  94                                                     ((1 *))
  95                                                     x-%offset%)
  96                                      (* temp
  97                                         (f2cl-lib:fref ap-%data%
  98                                                        (k)
  99                                                        ((1 *))
 100                                                        ap-%offset%))))
 101                             (setf k (f2cl-lib:int-add k 1))
 102                            label10))
 103                         (if nounit
 104                             (setf (f2cl-lib:fref x-%data%
 105                                                  (j)
 106                                                  ((1 *))
 107                                                  x-%offset%)
 108                                     (*
 109                                      (f2cl-lib:fref x-%data%
 110                                                     (j)
 111                                                     ((1 *))
 112                                                     x-%offset%)
 113                                      (f2cl-lib:fref ap-%data%
 114                                                     ((f2cl-lib:int-sub
 115                                                       (f2cl-lib:int-add kk j)
 116                                                       1))
 117                                                     ((1 *))
 118                                                     ap-%offset%))))))
 119                      (setf kk (f2cl-lib:int-add kk j))
 120                     label20)))
 121                 (t
 122                  (setf jx kx)
 123                  (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 124                                ((> j n) nil)
 125                    (tagbody
 126                      (cond
 127                        ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
 128                         (setf temp
 129                                 (f2cl-lib:fref x-%data%
 130                                                (jx)
 131                                                ((1 *))
 132                                                x-%offset%))
 133                         (setf ix kx)
 134                         (f2cl-lib:fdo (k kk (f2cl-lib:int-add k 1))
 135                                       ((> k
 136                                           (f2cl-lib:int-add kk
 137                                                             j
 138                                                             (f2cl-lib:int-sub
 139                                                              2)))
 140                                        nil)
 141                           (tagbody
 142                             (setf (f2cl-lib:fref x-%data%
 143                                                  (ix)
 144                                                  ((1 *))
 145                                                  x-%offset%)
 146                                     (+
 147                                      (f2cl-lib:fref x-%data%
 148                                                     (ix)
 149                                                     ((1 *))
 150                                                     x-%offset%)
 151                                      (* temp
 152                                         (f2cl-lib:fref ap-%data%
 153                                                        (k)
 154                                                        ((1 *))
 155                                                        ap-%offset%))))
 156                             (setf ix (f2cl-lib:int-add ix incx))
 157                            label30))
 158                         (if nounit
 159                             (setf (f2cl-lib:fref x-%data%
 160                                                  (jx)
 161                                                  ((1 *))
 162                                                  x-%offset%)
 163                                     (*
 164                                      (f2cl-lib:fref x-%data%
 165                                                     (jx)
 166                                                     ((1 *))
 167                                                     x-%offset%)
 168                                      (f2cl-lib:fref ap-%data%
 169                                                     ((f2cl-lib:int-sub
 170                                                       (f2cl-lib:int-add kk j)
 171                                                       1))
 172                                                     ((1 *))
 173                                                     ap-%offset%))))))
 174                      (setf jx (f2cl-lib:int-add jx incx))
 175                      (setf kk (f2cl-lib:int-add kk j))
 176                     label40)))))
 177              (t
 178               (setf kk (the f2cl-lib:integer4 (truncate (* n (+ n 1)) 2)))
 179               (cond
 180                 ((= incx 1)
 181                  (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
 182                                ((> j 1) nil)
 183                    (tagbody
 184                      (cond
 185                        ((/= (f2cl-lib:fref x (j) ((1 *))) zero)
 186                         (setf temp
 187                                 (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%))
 188                         (setf k kk)
 189                         (f2cl-lib:fdo (i n
 190                                        (f2cl-lib:int-add i
 191                                                          (f2cl-lib:int-sub 1)))
 192                                       ((> i (f2cl-lib:int-add j 1)) nil)
 193                           (tagbody
 194                             (setf (f2cl-lib:fref x-%data%
 195                                                  (i)
 196                                                  ((1 *))
 197                                                  x-%offset%)
 198                                     (+
 199                                      (f2cl-lib:fref x-%data%
 200                                                     (i)
 201                                                     ((1 *))
 202                                                     x-%offset%)
 203                                      (* temp
 204                                         (f2cl-lib:fref ap-%data%
 205                                                        (k)
 206                                                        ((1 *))
 207                                                        ap-%offset%))))
 208                             (setf k (f2cl-lib:int-sub k 1))
 209                            label50))
 210                         (if nounit
 211                             (setf (f2cl-lib:fref x-%data%
 212                                                  (j)
 213                                                  ((1 *))
 214                                                  x-%offset%)
 215                                     (*
 216                                      (f2cl-lib:fref x-%data%
 217                                                     (j)
 218                                                     ((1 *))
 219                                                     x-%offset%)
 220                                      (f2cl-lib:fref ap-%data%
 221                                                     ((f2cl-lib:int-add
 222                                                       (f2cl-lib:int-sub kk n)
 223                                                       j))
 224                                                     ((1 *))
 225                                                     ap-%offset%))))))
 226                      (setf kk
 227                              (f2cl-lib:int-sub kk
 228                                                (f2cl-lib:int-add
 229                                                 (f2cl-lib:int-sub n j)
 230                                                 1)))
 231                     label60)))
 232                 (t
 233                  (setf kx
 234                          (f2cl-lib:int-add kx
 235                                            (f2cl-lib:int-mul
 236                                             (f2cl-lib:int-sub n 1)
 237                                             incx)))
 238                  (setf jx kx)
 239                  (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
 240                                ((> j 1) nil)
 241                    (tagbody
 242                      (cond
 243                        ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
 244                         (setf temp
 245                                 (f2cl-lib:fref x-%data%
 246                                                (jx)
 247                                                ((1 *))
 248                                                x-%offset%))
 249                         (setf ix kx)
 250                         (f2cl-lib:fdo (k kk
 251                                        (f2cl-lib:int-add k
 252                                                          (f2cl-lib:int-sub 1)))
 253                                       ((> k
 254                                           (f2cl-lib:int-add kk
 255                                                             (f2cl-lib:int-sub
 256                                                              (f2cl-lib:int-add
 257                                                               n
 258                                                               (f2cl-lib:int-sub
 259                                                                (f2cl-lib:int-add
 260                                                                 j
 261                                                                 1))))))
 262                                        nil)
 263                           (tagbody
 264                             (setf (f2cl-lib:fref x-%data%
 265                                                  (ix)
 266                                                  ((1 *))
 267                                                  x-%offset%)
 268                                     (+
 269                                      (f2cl-lib:fref x-%data%
 270                                                     (ix)
 271                                                     ((1 *))
 272                                                     x-%offset%)
 273                                      (* temp
 274                                         (f2cl-lib:fref ap-%data%
 275                                                        (k)
 276                                                        ((1 *))
 277                                                        ap-%offset%))))
 278                             (setf ix (f2cl-lib:int-sub ix incx))
 279                            label70))
 280                         (if nounit
 281                             (setf (f2cl-lib:fref x-%data%
 282                                                  (jx)
 283                                                  ((1 *))
 284                                                  x-%offset%)
 285                                     (*
 286                                      (f2cl-lib:fref x-%data%
 287                                                     (jx)
 288                                                     ((1 *))
 289                                                     x-%offset%)
 290                                      (f2cl-lib:fref ap-%data%
 291                                                     ((f2cl-lib:int-add
 292                                                       (f2cl-lib:int-sub kk n)
 293                                                       j))
 294                                                     ((1 *))
 295                                                     ap-%offset%))))))
 296                      (setf jx (f2cl-lib:int-sub jx incx))
 297                      (setf kk
 298                              (f2cl-lib:int-sub kk
 299                                                (f2cl-lib:int-add
 300                                                 (f2cl-lib:int-sub n j)
 301                                                 1)))
 302                     label80)))))))
 303           (t
 304            (cond
 305              ((lsame uplo "U")
 306               (setf kk (the f2cl-lib:integer4 (truncate (* n (+ n 1)) 2)))
 307               (cond
 308                 ((= incx 1)
 309                  (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
 310                                ((> j 1) nil)
 311                    (tagbody
 312                      (setf temp
 313                              (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%))
 314                      (if nounit
 315                          (setf temp
 316                                  (* temp
 317                                     (f2cl-lib:fref ap-%data%
 318                                                    (kk)
 319                                                    ((1 *))
 320                                                    ap-%offset%))))
 321                      (setf k (f2cl-lib:int-sub kk 1))
 322                      (f2cl-lib:fdo (i (f2cl-lib:int-add j (f2cl-lib:int-sub 1))
 323                                     (f2cl-lib:int-add i (f2cl-lib:int-sub 1)))
 324                                    ((> i 1) nil)
 325                        (tagbody
 326                          (setf temp
 327                                  (+ temp
 328                                     (*
 329                                      (f2cl-lib:fref ap-%data%
 330                                                     (k)
 331                                                     ((1 *))
 332                                                     ap-%offset%)
 333                                      (f2cl-lib:fref x-%data%
 334                                                     (i)
 335                                                     ((1 *))
 336                                                     x-%offset%))))
 337                          (setf k (f2cl-lib:int-sub k 1))
 338                         label90))
 339                      (setf (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%)
 340                              temp)
 341                      (setf kk (f2cl-lib:int-sub kk j))
 342                     label100)))
 343                 (t
 344                  (setf jx
 345                          (f2cl-lib:int-add kx
 346                                            (f2cl-lib:int-mul
 347                                             (f2cl-lib:int-sub n 1)
 348                                             incx)))
 349                  (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
 350                                ((> j 1) nil)
 351                    (tagbody
 352                      (setf temp
 353                              (f2cl-lib:fref x-%data% (jx) ((1 *)) x-%offset%))
 354                      (setf ix jx)
 355                      (if nounit
 356                          (setf temp
 357                                  (* temp
 358                                     (f2cl-lib:fref ap-%data%
 359                                                    (kk)
 360                                                    ((1 *))
 361                                                    ap-%offset%))))
 362                      (f2cl-lib:fdo (k
 363                                     (f2cl-lib:int-add kk (f2cl-lib:int-sub 1))
 364                                     (f2cl-lib:int-add k (f2cl-lib:int-sub 1)))
 365                                    ((> k
 366                                        (f2cl-lib:int-add kk
 367                                                          (f2cl-lib:int-sub j)
 368                                                          1))
 369                                     nil)
 370                        (tagbody
 371                          (setf ix (f2cl-lib:int-sub ix incx))
 372                          (setf temp
 373                                  (+ temp
 374                                     (*
 375                                      (f2cl-lib:fref ap-%data%
 376                                                     (k)
 377                                                     ((1 *))
 378                                                     ap-%offset%)
 379                                      (f2cl-lib:fref x-%data%
 380                                                     (ix)
 381                                                     ((1 *))
 382                                                     x-%offset%))))
 383                         label110))
 384                      (setf (f2cl-lib:fref x-%data% (jx) ((1 *)) x-%offset%)
 385                              temp)
 386                      (setf jx (f2cl-lib:int-sub jx incx))
 387                      (setf kk (f2cl-lib:int-sub kk j))
 388                     label120)))))
 389              (t
 390               (setf kk 1)
 391               (cond
 392                 ((= incx 1)
 393                  (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 394                                ((> j n) nil)
 395                    (tagbody
 396                      (setf temp
 397                              (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%))
 398                      (if nounit
 399                          (setf temp
 400                                  (* temp
 401                                     (f2cl-lib:fref ap-%data%
 402                                                    (kk)
 403                                                    ((1 *))
 404                                                    ap-%offset%))))
 405                      (setf k (f2cl-lib:int-add kk 1))
 406                      (f2cl-lib:fdo (i (f2cl-lib:int-add j 1)
 407                                     (f2cl-lib:int-add i 1))
 408                                    ((> i n) nil)
 409                        (tagbody
 410                          (setf temp
 411                                  (+ temp
 412                                     (*
 413                                      (f2cl-lib:fref ap-%data%
 414                                                     (k)
 415                                                     ((1 *))
 416                                                     ap-%offset%)
 417                                      (f2cl-lib:fref x-%data%
 418                                                     (i)
 419                                                     ((1 *))
 420                                                     x-%offset%))))
 421                          (setf k (f2cl-lib:int-add k 1))
 422                         label130))
 423                      (setf (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%)
 424                              temp)
 425                      (setf kk
 426                              (f2cl-lib:int-add kk
 427                                                (f2cl-lib:int-add
 428                                                 (f2cl-lib:int-sub n j)
 429                                                 1)))
 430                     label140)))
 431                 (t
 432                  (setf jx kx)
 433                  (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 434                                ((> j n) nil)
 435                    (tagbody
 436                      (setf temp
 437                              (f2cl-lib:fref x-%data% (jx) ((1 *)) x-%offset%))
 438                      (setf ix jx)
 439                      (if nounit
 440                          (setf temp
 441                                  (* temp
 442                                     (f2cl-lib:fref ap-%data%
 443                                                    (kk)
 444                                                    ((1 *))
 445                                                    ap-%offset%))))
 446                      (f2cl-lib:fdo (k (f2cl-lib:int-add kk 1)
 447                                     (f2cl-lib:int-add k 1))
 448                                    ((> k
 449                                        (f2cl-lib:int-add kk
 450                                                          n
 451                                                          (f2cl-lib:int-sub j)))
 452                                     nil)
 453                        (tagbody
 454                          (setf ix (f2cl-lib:int-add ix incx))
 455                          (setf temp
 456                                  (+ temp
 457                                     (*
 458                                      (f2cl-lib:fref ap-%data%
 459                                                     (k)
 460                                                     ((1 *))
 461                                                     ap-%offset%)
 462                                      (f2cl-lib:fref x-%data%
 463                                                     (ix)
 464                                                     ((1 *))
 465                                                     x-%offset%))))
 466                         label150))
 467                      (setf (f2cl-lib:fref x-%data% (jx) ((1 *)) x-%offset%)
 468                              temp)
 469                      (setf jx (f2cl-lib:int-add jx incx))
 470                      (setf kk
 471                              (f2cl-lib:int-add kk
 472                                                (f2cl-lib:int-add
 473                                                 (f2cl-lib:int-sub n j)
 474                                                 1)))
 475                     label160))))))))
 476         (go end_label)
 477        end_label
 478         (return (values nil nil nil nil nil nil nil))))))
 479
 480 (in-package #-gcl #:cl-user #+gcl "CL-USER")
 481 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 482 (eval-when (:load-toplevel :compile-toplevel :execute)
 483   (setf (gethash 'fortran-to-lisp::dtpmv fortran-to-lisp::*f2cl-function-info*)
 484           (fortran-to-lisp::make-f2cl-finfo
 485            :arg-types '((simple-string) (simple-string) (simple-string)
 486                         (fortran-to-lisp::integer4) (array double-float (*))
 487                         (array double-float (*)) (fortran-to-lisp::integer4))
 488            :return-values '(nil nil nil nil nil nil nil)
 489            :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
 490