|
a/LibDBlas.mod |
|
b/LibDBlas.mod |
|
... |
|
... |
| 34 |
(* die entsprechenden Routinen in LibDBlasM2 *)
|
34 |
(* die entsprechenden Routinen in LibDBlasM2 *)
|
| 35 |
(* 20.06.18, MRi: Erstellen der erstern uebersetzbaren Version von *)
|
35 |
(* 20.06.18, MRi: Erstellen der erstern uebersetzbaren Version von *)
|
| 36 |
(* dznrm2,zdotc,zscal,zaxpy,zswap,zdrot *)
|
36 |
(* dznrm2,zdotc,zscal,zaxpy,zswap,zdrot *)
|
| 37 |
(* 21.06.18, MRi: Korrekturen in dznrm2 und zdotc *)
|
37 |
(* 21.06.18, MRi: Korrekturen in dznrm2 und zdotc *)
|
| 38 |
(* 11.09.18, MRi: Hinzufuegen von zcopy und zgemv (definition) *)
|
38 |
(* 11.09.18, MRi: Hinzufuegen von zcopy und zgemv (definition) *)
|
|
|
39 |
(* 30.09.18, MRi: Hinzufuegen von zdotu *)
|
| 39 |
(*------------------------------------------------------------------------*)
|
40 |
(*------------------------------------------------------------------------*)
|
| 40 |
(* Testroutinen *)
|
41 |
(* Testroutinen *)
|
| 41 |
(* *)
|
42 |
(* *)
|
| 42 |
(* - zgemm in TstCmplxMaMul *)
|
43 |
(* - zgemm in TstCmplxMaMul *)
|
| 43 |
(*------------------------------------------------------------------------*)
|
44 |
(*------------------------------------------------------------------------*)
|
|
... |
|
... |
| 627 |
INC(ix,IncX); INC(iy,IncY);
|
628 |
INC(ix,IncX); INC(iy,IncY);
|
| 628 |
END;
|
629 |
END;
|
| 629 |
END;
|
630 |
END;
|
| 630 |
END zcopy;
|
631 |
END zcopy;
|
| 631 |
|
632 |
|
|
|
633 |
PROCEDURE zdotu( N : INTEGER;
|
|
|
634 |
VAR X : (* ARRAY OF *) CFLOAT;
|
|
|
635 |
IncX : INTEGER;
|
|
|
636 |
VAR Y : (* ARRAY OF *) CFLOAT;
|
|
|
637 |
IncY : INTEGER) : CFLOAT;
|
|
|
638 |
|
|
|
639 |
CONST veclen = 4;
|
|
|
640 |
|
|
|
641 |
VAR dtemp : CFLOAT;
|
|
|
642 |
i,ix,iy,m : INTEGER;
|
|
|
643 |
XX,YY : PZVEKTOR;
|
|
|
644 |
BEGIN
|
|
|
645 |
IF (N <= 0) THEN RETURN zero; END;
|
|
|
646 |
|
|
|
647 |
XX:=SYSTEM.CAST(PZVEKTOR,SYSTEM.ADR(X));
|
|
|
648 |
YY:=SYSTEM.CAST(PZVEKTOR,SYSTEM.ADR(Y));
|
|
|
649 |
|
|
|
650 |
dtemp := zero;
|
|
|
651 |
IF (IncX = 1) AND (IncY = 1) THEN
|
|
|
652 |
(* code for both increments equal to 1 *)
|
|
|
653 |
m := N MOD veclen;
|
|
|
654 |
IF (m # 0) THEN
|
|
|
655 |
FOR i:=0 TO m-1 DO (* clean-up loop *)
|
|
|
656 |
dtemp:=dtemp + XX^[i]*YY^[i];
|
|
|
657 |
END;
|
|
|
658 |
IF (N < veclen) THEN RETURN dtemp; END;
|
|
|
659 |
END;
|
|
|
660 |
(* i := m - veclen; *)
|
|
|
661 |
FOR i:=m TO N-1 BY veclen DO
|
|
|
662 |
dtemp:=dtemp + XX^[i+0]*YY^[i+0] + XX^[i+1]*YY^[i+1] +
|
|
|
663 |
XX^[i+2]*YY^[i+2] + XX^[i+3]*YY^[i+3];
|
|
|
664 |
END;
|
|
|
665 |
ELSE
|
|
|
666 |
(* code for unequal increments or equal increments not equal to 1 *)
|
|
|
667 |
ix := 0; IF (IncX < 0) THEN ix := (1-N)*IncX; END;
|
|
|
668 |
iy := 0; IF (IncY < 0) THEN iy := (1-N)*IncY; END;
|
|
|
669 |
FOR i:=1 TO N DO
|
|
|
670 |
dtemp:=dtemp + XX^[ix]*YY^[iy];
|
|
|
671 |
INC(ix,IncX); INC(iy,IncY);
|
|
|
672 |
END;
|
|
|
673 |
END;
|
|
|
674 |
RETURN dtemp;
|
|
|
675 |
END zdotu;
|
|
|
676 |
|
| 632 |
PROCEDURE zdotc( N : INTEGER;
|
677 |
PROCEDURE zdotc( N : INTEGER;
|
| 633 |
VAR X : (* ARRAY OF *) CFLOAT;
|
678 |
VAR X : (* ARRAY OF *) CFLOAT;
|
| 634 |
IncX : INTEGER;
|
679 |
IncX : INTEGER;
|
| 635 |
VAR Y : (* ARRAY OF *) CFLOAT;
|
680 |
VAR Y : (* ARRAY OF *) CFLOAT;
|
| 636 |
IncY : INTEGER) : CFLOAT;
|
681 |
IncY : INTEGER) : CFLOAT;
|