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