|
a/LibDBlasM2.def |
|
b/LibDBlasM2.def |
|
... |
|
... |
| 30 |
(* idamax : index of vector element with largest absolute value *)
|
30 |
(* idamax : index of vector element with largest absolute value *)
|
| 31 |
(* idamin : index of vector element with smallest absolute value *)
|
31 |
(* idamin : index of vector element with smallest absolute value *)
|
| 32 |
(* dasum : sum of vector elements *)
|
32 |
(* dasum : sum of vector elements *)
|
| 33 |
(* dgemv : matrix vector operations *)
|
33 |
(* dgemv : matrix vector operations *)
|
| 34 |
(* dgemm : matrix matrix operations *)
|
34 |
(* dgemm : matrix matrix operations *)
|
|
|
35 |
(* dger : dyadic product of two vectors *)
|
|
|
36 |
(* dgemv : matrix vector operations (complex) *)
|
| 35 |
(* zgemm : matrix matrix operations (complex) *)
|
37 |
(* zgemm : matrix matrix operations (complex) *)
|
| 36 |
(* dger : dyadic product of two vectors *)
|
|
|
| 37 |
(* *)
|
38 |
(* *)
|
| 38 |
(* Additional Routines *)
|
39 |
(* Additional Routines *)
|
| 39 |
(* *)
|
40 |
(* *)
|
| 40 |
(* SumVek : Sum vector elements *)
|
41 |
(* SumVek : Sum vector elements *)
|
| 41 |
(* AbsSumVek : Sum of absolute values of vector element *)
|
42 |
(* AbsSumVek : Sum of absolute values of vector element *)
|
| 42 |
(* ENorm : Euklidian norm of a vector *)
|
43 |
(* ENorm : Euklidian norm of a vector *)
|
| 43 |
(*------------------------------------------------------------------------*)
|
44 |
(*------------------------------------------------------------------------*)
|
| 44 |
|
45 |
|
| 45 |
(* $Id: LibDBlasM2.def,v 1.10 2017/10/29 09:55:06 mriedl Exp mriedl $ *)
|
46 |
(* $Id: LibDBlasM2.def,v 1.12 2018/09/12 13:20:49 mriedl Exp mriedl $ *)
|
| 46 |
|
47 |
|
| 47 |
FROM Deklera IMPORT FLOAT; (* REAL type *)
|
48 |
FROM Deklera IMPORT FLOAT,CFLOAT; (* REAL/COMPLEX Type *)
|
| 48 |
|
49 |
|
| 49 |
PROCEDURE SumVek(VAR X : ARRAY OF FLOAT;
|
50 |
PROCEDURE SumVek(VAR X : ARRAY OF FLOAT;
|
| 50 |
s,e : CARDINAL) : FLOAT;
|
51 |
s,e : CARDINAL) : FLOAT;
|
| 51 |
|
52 |
|
| 52 |
(*----------------------------------------------------------------*)
|
53 |
(*----------------------------------------------------------------*)
|
|
... |
|
... |
| 349 |
(* matrix C. N must be at least zero. *)
|
350 |
(* matrix C. N must be at least zero. *)
|
| 350 |
(* K : On entry, K specifies the number of columns of the *)
|
351 |
(* K : On entry, K specifies the number of columns of the *)
|
| 351 |
(* matrix op( A ) and the number of rows of the matrix *)
|
352 |
(* matrix op( A ) and the number of rows of the matrix *)
|
| 352 |
(* op( B ). K must be at least zero. *)
|
353 |
(* op( B ). K must be at least zero. *)
|
| 353 |
(* Alpha : On entry, Alpha specifies the scalar alpha. *)
|
354 |
(* Alpha : On entry, Alpha specifies the scalar alpha. *)
|
| 354 |
(* A : LONGREAL array of DIMENSION ( LDA, ka ), where ka is *)
|
355 |
(* A : FLOAT array of DIMENSION ( LDA, ka ), where ka is *)
|
| 355 |
(* k when TransA = 'N' or 'n', and is m otherwise. *)
|
356 |
(* k when TransA = 'N' or 'n', and is m otherwise. *)
|
| 356 |
(* Before entry with TransA = 'N' or 'n', the leading *)
|
357 |
(* Before entry with TransA = 'N' or 'n', the leading *)
|
| 357 |
(* m by k part of the array A must contain the matrix *)
|
358 |
(* m by k part of the array A must contain the matrix *)
|
| 358 |
(* A, otherwise the leading k by m part of the array *)
|
359 |
(* A, otherwise the leading k by m part of the array *)
|
| 359 |
(* A must contain the matrix A. *)
|
360 |
(* A must contain the matrix A. *)
|
| 360 |
(* Unchanged on exit. *)
|
361 |
(* Unchanged on exit. *)
|
| 361 |
(* LDA : On entry, LDA specifies the first dimension of A as *)
|
362 |
(* LDA : On entry, LDA specifies the first dimension of A as *)
|
| 362 |
(* declared in the calling (sub) program. When TransA = *)
|
363 |
(* declared in the calling (sub) program. When TransA = *)
|
| 363 |
(* 'N' or 'n' then LDA must be at least max( 1, m ), *)
|
364 |
(* 'N' or 'n' then LDA must be at least max( 1, m ), *)
|
| 364 |
(* otherwise LDA must be at least max( 1, k ). *)
|
365 |
(* otherwise LDA must be at least max( 1, k ). *)
|
| 365 |
(* B : LONGREAL array of DIMENSION ( LDB, kb ), *)
|
366 |
(* B : FLOAT array of DIMENSION ( LDB, kb ), *)
|
| 366 |
(* where kb is n when TransB = 'N' or 'n', and is k *)
|
367 |
(* where kb is n when TransB = 'N' or 'n', and is k *)
|
| 367 |
(* otherwise. Before entry with TransB = 'N' or 'n', *)
|
368 |
(* otherwise. Before entry with TransB = 'N' or 'n', *)
|
| 368 |
(* the leading k by n part of the array B must *)
|
369 |
(* the leading k by n part of the array B must *)
|
| 369 |
(* contain the matrix B, otherwise the leading n by k *)
|
370 |
(* contain the matrix B, otherwise the leading n by k *)
|
| 370 |
(* part of the array B must contain the matrix B. *)
|
371 |
(* part of the array B must contain the matrix B. *)
|
|
... |
|
... |
| 373 |
(* declared in the calling (sub) program. When TransB = *)
|
374 |
(* declared in the calling (sub) program. When TransB = *)
|
| 374 |
(* 'N' or 'n' then LDB must be at least max( 1, k ), *)
|
375 |
(* 'N' or 'n' then LDB must be at least max( 1, k ), *)
|
| 375 |
(* otherwise LDB must be at least max( 1, n ). *)
|
376 |
(* otherwise LDB must be at least max( 1, n ). *)
|
| 376 |
(* Beta : On entry, Beta specifies the scalar beta. When Beta *)
|
377 |
(* Beta : On entry, Beta specifies the scalar beta. When Beta *)
|
| 377 |
(* is supplied as zero then C need not be set on input. *)
|
378 |
(* is supplied as zero then C need not be set on input. *)
|
| 378 |
(* C : LONGREAL array of DIMENSION ( LDC, n ). *)
|
379 |
(* C : FLOAT array of DIMENSION ( LDC, n ). *)
|
| 379 |
(* Before entry, the leading m by n part of the array *)
|
380 |
(* Before entry, the leading m by n part of the array *)
|
| 380 |
(* C must contain the matrix C, except when beta is *)
|
381 |
(* C must contain the matrix C, except when beta is *)
|
| 381 |
(* zero, in which case C need not be set on entry. *)
|
382 |
(* zero, in which case C need not be set on entry. *)
|
| 382 |
(* On exit, the array C is overwritten by the m by n *)
|
383 |
(* On exit, the array C is overwritten by the m by n *)
|
| 383 |
(* matrix ( alpha*op( A )*op( B ) + beta*C ). *)
|
384 |
(* matrix ( alpha*op( A )*op( B ) + beta*C ). *)
|
|
... |
|
... |
| 445 |
(* must contain the matrix of coefficients. On exit, A *)
|
446 |
(* must contain the matrix of coefficients. On exit, A *)
|
| 446 |
(* is overwritten by the updated matrix. *)
|
447 |
(* is overwritten by the updated matrix. *)
|
| 447 |
(* *)
|
448 |
(* *)
|
| 448 |
(*--------------------------------------------------------------*)
|
449 |
(*--------------------------------------------------------------*)
|
| 449 |
|
450 |
|
|
|
451 |
PROCEDURE zswap( N : CARDINAL;
|
|
|
452 |
VAR X : ARRAY OF CFLOAT;
|
|
|
453 |
IncX : INTEGER;
|
|
|
454 |
VAR Y : ARRAY OF CFLOAT;
|
|
|
455 |
IncY : INTEGER);
|
|
|
456 |
|
|
|
457 |
(*----------------------------------------------------------------*)
|
|
|
458 |
(* Swap complex vectors X and Y *)
|
|
|
459 |
(*----------------------------------------------------------------*)
|
|
|
460 |
|
|
|
461 |
PROCEDURE zcopy( N : INTEGER;
|
|
|
462 |
VAR X : ARRAY OF CFLOAT;
|
|
|
463 |
IncX : INTEGER;
|
|
|
464 |
VAR Y : ARRAY OF CFLOAT;
|
|
|
465 |
IncY : INTEGER);
|
|
|
466 |
|
|
|
467 |
(*----------------------------------------------------------------*)
|
|
|
468 |
(* copies a vector, x, to a vector, y. *)
|
|
|
469 |
(* uses unrolled loops for increments equal to one. *)
|
|
|
470 |
(* jack dongarra, linpack, 3/11/78. *)
|
|
|
471 |
(* MRi, Modula-2 10.04.16 | 09.09.18 (complex version) *)
|
|
|
472 |
(*----------------------------------------------------------------*)
|
|
|
473 |
|
|
|
474 |
PROCEDURE zdotc( N : INTEGER;
|
|
|
475 |
VAR X : ARRAY OF CFLOAT;
|
|
|
476 |
IncX : INTEGER;
|
|
|
477 |
VAR Y : ARRAY OF CFLOAT;
|
|
|
478 |
IncY : INTEGER) : CFLOAT;
|
|
|
479 |
|
|
|
480 |
(*----------------------------------------------------------------*)
|
|
|
481 |
(* Forms the dot product of two vectors. Uses unrolled loops for *)
|
|
|
482 |
(* increments equal to one. *)
|
|
|
483 |
(*----------------------------------------------------------------*)
|
|
|
484 |
|
|
|
485 |
|
|
|
486 |
PROCEDURE dznrm2( N : INTEGER;
|
|
|
487 |
VAR X : ARRAY OF CFLOAT;
|
|
|
488 |
IncX : INTEGER) : FLOAT;
|
|
|
489 |
|
|
|
490 |
(*----------------------------------------------------------------*)
|
|
|
491 |
(* dznrm2 returns the euclidean norm of a vector so that *)
|
|
|
492 |
(* dznrm2 := sqrt( X**H*X ) *)
|
|
|
493 |
(*----------------------------------------------------------------*)
|
|
|
494 |
|
|
|
495 |
PROCEDURE zscal( n : INTEGER;
|
|
|
496 |
da : CFLOAT;
|
|
|
497 |
VAR dx : ARRAY OF CFLOAT;
|
|
|
498 |
IncX : INTEGER);
|
|
|
499 |
|
|
|
500 |
(*----------------------------------------------------------------*)
|
|
|
501 |
(* Scales a vector by a constant (UNROLLED version) *)
|
|
|
502 |
(*----------------------------------------------------------------*)
|
|
|
503 |
|
|
|
504 |
PROCEDURE zaxpy( n : INTEGER;
|
|
|
505 |
da : CFLOAT;
|
|
|
506 |
VAR X : ARRAY OF CFLOAT;
|
|
|
507 |
IncX : INTEGER;
|
|
|
508 |
VAR Y : ARRAY OF CFLOAT;
|
|
|
509 |
IncY : INTEGER);
|
|
|
510 |
|
|
|
511 |
(*----------------------------------------------------------------*)
|
|
|
512 |
(* constant times a vector plus a vector *)
|
|
|
513 |
(*----------------------------------------------------------------*)
|
|
|
514 |
|
|
|
515 |
PROCEDURE zdrot( N : INTEGER;
|
|
|
516 |
VAR X : ARRAY OF CFLOAT;
|
|
|
517 |
IncX : INTEGER;
|
|
|
518 |
VAR Y : ARRAY OF CFLOAT;
|
|
|
519 |
IncY : INTEGER;
|
|
|
520 |
c,s : FLOAT);
|
|
|
521 |
|
|
|
522 |
(*----------------------------------------------------------------*)
|
|
|
523 |
(* Applies a plane rotation, where the cos and sin (c and s) are *)
|
|
|
524 |
(* real and the vectors cx and cy are complex. *)
|
|
|
525 |
(*----------------------------------------------------------------*)
|
|
|
526 |
|
|
|
527 |
PROCEDURE zgemv( Trans : CHAR;
|
|
|
528 |
M,N : INTEGER;
|
|
|
529 |
Alpha : CFLOAT;
|
|
|
530 |
VAR A : ARRAY OF ARRAY OF CFLOAT;
|
|
|
531 |
lda : INTEGER;
|
|
|
532 |
VAR X : ARRAY OF CFLOAT;
|
|
|
533 |
IncX : INTEGER;
|
|
|
534 |
Beta : CFLOAT;
|
|
|
535 |
VAR Y : ARRAY OF CFLOAT;
|
|
|
536 |
IncY : INTEGER);
|
|
|
537 |
|
|
|
538 |
(*----------------------------------------------------------------*)
|
|
|
539 |
(* Performs one of the matrix-vector operations *)
|
|
|
540 |
(* *)
|
|
|
541 |
(* Y = Alpha* A *x + Beta*Y, or *)
|
|
|
542 |
(* Y = Alpha* A' *x + Beta*Y, or *)
|
|
|
543 |
(* Y = Alpha*conjg(A')*x + Beta*Y,; *)
|
|
|
544 |
(* *)
|
|
|
545 |
(* where Alpha and Beta are scalars, X and Y are vectors *)
|
|
|
546 |
(* and A is an M by N matrix. *)
|
|
|
547 |
(* *)
|
|
|
548 |
(* parameters *)
|
|
|
549 |
(* *)
|
|
|
550 |
(* Trans : trans specifies the operation to be performed as *)
|
|
|
551 |
(* follows: *)
|
|
|
552 |
(* *)
|
|
|
553 |
(* trans = 'N' or 'n' Y = Alpha*A*X + Beta*Y *)
|
|
|
554 |
(* trans = 'T' or 't' Y = Alpha*A'*X + Beta*Y *)
|
|
|
555 |
(* trans = 'C' or 'c' Y = Alpha*conjg(A')*X + Beta*Y *)
|
|
|
556 |
(* *)
|
|
|
557 |
(* *)
|
|
|
558 |
(* M : M specifies the number of rows of the matrix A. *)
|
|
|
559 |
(* M must be at least zero. *)
|
|
|
560 |
(* N : N specifies the number of columns of the matrix A. *)
|
|
|
561 |
(* N must be at least zero. *)
|
|
|
562 |
(* Alpha : Alpha specifies the scalar Alpha *)
|
|
|
563 |
(* A : array of dimension (lda,N) *)
|
|
|
564 |
(* Before entry, the leading M by N part of the *)
|
|
|
565 |
(* array A must contain the matrix of coefficients. *)
|
|
|
566 |
(* Unchanged on exit. *)
|
|
|
567 |
(* lda : on entry, lda specifies the first dimension *)
|
|
|
568 |
(* of A as declared in the calling (sub) program. *)
|
|
|
569 |
(* lda must be at least max(1,M). *)
|
|
|
570 |
(* X : array of dimension at least (1+(n-1 )*abs(incx)) *)
|
|
|
571 |
(* when trans = 'n' or 'N' and at least *)
|
|
|
572 |
(* (1+(m-1 )*abs(incx)) otherwise. *)
|
|
|
573 |
(* Before entry, the incremented array x must contain *)
|
|
|
574 |
(* the vector X. Unchanged on exit. *)
|
|
|
575 |
(* IncX : IncX specifies the increment for the elements of *)
|
|
|
576 |
(* X. IncX must not be zero. *)
|
|
|
577 |
(* Beta : Beta specifies the scalar Beta. When Beta is *)
|
|
|
578 |
(* supplied as zero then y need not be set on input. *)
|
|
|
579 |
(* Unchanged on exit. *)
|
|
|
580 |
(* Y : array of dimension at least (1+(m-1)*abs(incy)) *)
|
|
|
581 |
(* when trans = 'N' or 'n' and at least *)
|
|
|
582 |
(* (1+(n-1 *abs(incy)) otherwise. *)
|
|
|
583 |
(* Before entry with beta non-zero, the incremented *)
|
|
|
584 |
(* array Y must contain the vector Y. On exit, Y is *)
|
|
|
585 |
(* overwritten by the updated vector Y. *)
|
|
|
586 |
(* IncY : IncY specifies the increment for the elements of *)
|
|
|
587 |
(* Y. IncY must not be zero. *)
|
|
|
588 |
(* *)
|
|
|
589 |
(* level 2 blas routine. *)
|
|
|
590 |
(* *)
|
|
|
591 |
(* -- written on 22-october-1986. *)
|
|
|
592 |
(* Jack Dongarra, Argonne National Lab. *)
|
|
|
593 |
(* Jeremy du Croz, NAG central office. *)
|
|
|
594 |
(* Sven Hammarling, NAG central office. *)
|
|
|
595 |
(* Richard Hanson, Sandia National Labs. *)
|
|
|
596 |
(*----------------------------------------------------------------*)
|
|
|
597 |
|
| 450 |
PROCEDURE zgemm( TransA,TransB : CHAR;
|
598 |
PROCEDURE zgemm( TransA,TransB : CHAR;
|
| 451 |
M,N,K : INTEGER;
|
599 |
M,N,K : INTEGER;
|
| 452 |
Alpha : LONGCOMPLEX;
|
600 |
Alpha : CFLOAT;
|
| 453 |
VAR A : ARRAY OF ARRAY OF LONGCOMPLEX;
|
601 |
VAR A : ARRAY OF ARRAY OF CFLOAT;
|
| 454 |
LDA : INTEGER;
|
602 |
LDA : INTEGER;
|
| 455 |
VAR B : ARRAY OF ARRAY OF LONGCOMPLEX;
|
603 |
VAR B : ARRAY OF ARRAY OF CFLOAT;
|
| 456 |
LDB : INTEGER;
|
604 |
LDB : INTEGER;
|
| 457 |
Beta : LONGCOMPLEX;
|
605 |
Beta : CFLOAT;
|
| 458 |
VAR C : ARRAY OF ARRAY OF LONGCOMPLEX;
|
606 |
VAR C : ARRAY OF ARRAY OF CFLOAT;
|
| 459 |
LDC : INTEGER);
|
607 |
LDC : INTEGER);
|
| 460 |
|
608 |
|
| 461 |
(*----------------------------------------------------------------*)
|
609 |
(*----------------------------------------------------------------*)
|
| 462 |
(* Purpose *)
|
610 |
(* Purpose *)
|
| 463 |
(* ======= *)
|
611 |
(* ======= *)
|