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