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