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