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