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