LibDBlasF77.def.m2pp
521 lines (444 with data), 26.0 kB
DEFINITION MODULE LibDBlasF77;
(*========================================================================*)
(* HINWEIS : Bitte nur die Datei LibDBlasF77.mod.m2pp editieren *)
(*========================================================================*)
(* Es sind 2 Versionen enthalten die mit *)
(* *)
(* m2pp -D __{Parameter}__ < LibDBlasF77.mod.m2pp > LibDBlasF77.mod *)
(* *)
(* mit Parameter = {NOOPENMP|OPENMP} erzeugt werden koennen. *)
(* *)
(* NOOPENMP : "Standard" BLAS subroutinen werden genutzt *)
(* OPENMP : OpenMP parallelisiert Version von dgemm wird genutzt *)
(* *)
(* With the option OPENMP you can request using an OpenMP parallisiezed *)
(* version of dgemm, otherwise use NOOPENMP *)
(*========================================================================*)
(* Interface to dblas level 1,2 & 3 FORTRAN 77 subroutines. *)
(* *)
(* Jack Dongarra, linpack, 3/11/78. *)
(* *)
(* To Do: Lot of other routines ;-) *)
(* *)
(* Routine provided so far are: *)
(* *)
(* Level 1 *)
(* *)
(* dnrm2 : euklidian norm of a vector *)
(* * dswap : swap two vectors *)
(* * dcopy : copy a vector to a vector *)
(* drot : plane rotation *)
(* drotg : construct givens rotation *)
(* * dscal : scale vector by a constant *)
(* * daxpy : constant times a vector plus a vector *)
(* * ddot : dot product of two vectors *)
(* * idamax : index of vector element with largest absolute value *)
(* * idamin : index of vector element with smalles absolute value *)
(* * dasum : sum of absolut values of real vector elements *)
(* *)
(* zswap : swap two vectors *)
(* zcopy : copy a vector to a vector *)
(* zdotc : dot product of two vectors *)
(* dznrm2 : euklidian norm of a vector *)
(* zscal : scale vector by a constant *)
(* * zaxpy : constant times a vector plus a vector *)
(* zdrot : plane rotation *)
(* *)
(* Level 2 *)
(* *)
(* dgemv : double precision matrix vector multiplication *)
(* zgemv : double complex matrix vector multiplication *)
(* *)
(* Level 3 *)
(* *)
(* sgemm : single precision matrix matrix multiplication *)
(* dgemm : double precision matrix matrix multiplication *)
(* zgemm : double complex matrix matrix multiplication *)
(* *)
(*------------------------------------------------------------------------*)
(* Last change: *)
(* *)
(* 06.09.15, MRi: First version (only ddot) *)
(* 01.12.15, MRi: Added dscal,daxpy *)
(* 02.12.15, MRi: Added dasum,dnrm2,idamax *)
(* 30.03.16, MRi: Added dswap *)
(* 15.04.16, MRi: Added dcopy,drot,drotg *)
(* Changed ARRAY OF DOUBLEPRECISION to *)
(* (* ARRAY OF *) DOUBLEPRECISION *)
(* 29.10.17, MRi: Added dgemm *)
(* 01.11.17, MRi: Added idamin *)
(* 23.06.18, MRi: Added zgemm *)
(* 11.09.18, MRi: Added zswap,zcopy,zdotc,dznrm2,zscal,zaxpy,zdrot *)
(* and dgemv, zgemv *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: LibDBlasF77.def.m2pp,v 1.3 2018/09/12 13:20:49 mriedl Exp mriedl $ *)
IMPORT LibDBlasL1F77;
IMPORT LibDBlasL2F77;
IMPORT LibDBlasL3F77;
TYPE DOUBLEPRECISION = LibDBlasL1F77.DOUBLEPRECISION;
INTEGER4 = LibDBlasL1F77.INTEGER4;
CHAR1 = LibDBlasL1F77.CHAR1;
(*
* PROCEDURE dnrm2(VAR n : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLEPRECISION;
* VAR IncX : INTEGER4): DOUBLEPRECISION;
*)
CONST dnrm2 = LibDBlasL1F77.dnrm2_;
(*----------------------------------------------------------------*)
(* dnrm2 returns the euclidean norm of a vector via the function *)
(* name, so that dnrm2 := sqrt( x^{tr}*x ) *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE dswap(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incx : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incy : INTEGER4);
*)
CONST dswap = LibDBlasL1F77.dswap_;
(*----------------------------------------------------------------*)
(* Interchanges two vectors using unrolled loops for increments *)
(* equal to 1. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE dcopy(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLEPRECISION;
* VAR IncX : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLEPRECISION;
* VAR IncY : INTEGER);
*)
CONST dcopy = LibDBlasL1F77.dcopy_;
(*----------------------------------------------------------------*)
(* copies a vector, x, to a vector, y. *)
(* uses unrolled loops for increments equal to one. *)
(* jack dongarra, linpack, 3/11/78. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE drot(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incX : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incY : INTEGER4;
* VAR c,s : DOUBLEPRECISION);
*)
CONST drot = LibDBlasL1F77.drot_;
(*---------------------------------------------------------------*)
(* Applies a plane rotation. *)
(* Jack Dongarra, linpack, 3/11/78. *)
(*---------------------------------------------------------------*)
(*
* PROCEDURE drotg(VAR da : DOUBLEPRECISION;
* VAR db : DOUBLEPRECISION;
* VAR c : DOUBLEPRECISION;
* VAR s : DOUBLEPRECISION);
*)
CONST drotg = LibDBlasL1F77.drotg_;
(*---------------------------------------------------------------*)
(* Construct a Givens plane rotation *)
(* Jack Dongarra, linpack, 3/11/78. *)
(*---------------------------------------------------------------*)
(*
* PROCEDURE dscal(VAR n : INTEGER4;
* VAR da : DOUBLEPRECISION;
* VAR dx : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incx : INTEGER4);
*)
CONST dscal = LibDBlasL1F77.dscal_;
(*----------------------------------------------------------------*)
(* Scales a vector by a constant *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE daxpy(VAR n : INTEGER4;
* VAR da : DOUBLEPRECISION;
* VAR dx : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incx : INTEGER4;
* VAR dy : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incy : INTEGER4);
*)
CONST daxpy = LibDBlasL1F77.daxpy_;
(*----------------------------------------------------------------*)
(* Constant times a vector plus a vector *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE ddot(VAR N : INTEGER4;
* VAR DX : (* ARRAY OF *) DOUBLEPRECISION;
* VAR INCX : INTEGER4;
* VAR DY : (* ARRAY OF *) DOUBLEPRECISION;
* VAR INCY : INTEGER4) : DOUBLEPRECISION;
*)
CONST ddot = LibDBlasL1F77.ddot_;
(*----------------------------------------------------------------*)
(* Forms the dot product of two vectors *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE idamax(VAR n : INTEGER4;
* VAR dx : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incx : INTEGER4) : INTEGER4;
*)
CONST idamax = LibDBlasL1F77.idamax_;
(*----------------------------------------------------------------*)
(* Finds the index of element having max. absolute value. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE idamin(VAR n : INTEGER4;
* VAR dx : (* ARRAY OF *) DOUBLEPRECISION;
* VAR incx : INTEGER4) : INTEGER4;
*)
CONST idamin = LibDBlasL1F77.idamin_;
(*----------------------------------------------------------------*)
(* Finds the index of element having min. absolute value. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE dasum(VAR dim : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLEPRECISION;
* VAR Inc : INTEGER4) : DOUBLEPRECISION;
*)
CONST dasum = LibDBlasL1F77.dasum_;
(*----------------------------------------------------------------*)
(* Berechnet die Summe der Absolutwerte der im Feld X gespeich- *)
(* erten Zahlen. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE dgemv( Trans : CHAR1;
* M,N : INTEGER4;
* Alpha : DOUBLEPRECISION;
* VAR A : ARRAY OF ARRAY OF DOUBLEPRECISION;
* LDA : INTEGER4;
* VAR X : ARRAY OF DOUBLEPRECISION;
* IncX : INTEGER4;
* Beta : DOUBLEPRECISION;
* VAR Y : ARRAY OF DOUBLEPRECISION;
* IncY : INTEGER4);
*)
CONST dgemv = LibDBlasL2F77.dgemv;
(*----------------------------------------------------------------*)
(* Aufruf der Fortran Version von BLAS2 subroutine dgemv *)
(* ueber Schnittstelle die fuer eine korrekte Umsetzung der *)
(* Parameter sorgt. *)
(* Durch die Schnittstelle wird auch erreicht dass die Routine *)
(* "normal" aufgerufen werden kann wie von Modula-2 her gewoehnt *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE sgemm( TA : CHAR1;
* TB : CHAR1;
* M,N,K : INTEGER4;
* Alpha : REAL4;
* VAR A : ARRAY OF ARRAY OF REAL4;
* lda : INTEGER4;
* VAR B : ARRAY OF ARRAY OF REAL4;
* ldb : INTEGER4;
* Beta : REAL4;
* VAR C : ARRAY OF ARRAY OF REAL4;
* ldc : INTEGER4);
*)
CONST sgemm = LibDBlasL3F77.dgemm;
(*----------------------------------------------------------------*)
(* Aufruf der Fortran Version von BLAS3 subroutine sgemm *)
(* ueber Schnittstelle die fuer eine korrekte Umsetzung der *)
(* Parameter sorgt. *)
(* Durch die Schnittstelle wird auch erreicht dass die Routine *)
(* "normal" aufgerufen werden kann wie von Modula-2 her gewoehnt *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE dgemm( TA : CHAR1;
* TB : CHAR1;
* M,N,K : INTEGER4;
* Alpha : DOUBLEPRECISION;
* VAR A : ARRAY OF ARRAY OF DOUBLEPRECISION;
* lda : INTEGER4;
* VAR B : ARRAY OF ARRAY OF DOUBLEPRECISION;
* ldb : INTEGER4;
* Beta : DOUBLEPRECISION;
* VAR C : ARRAY OF ARRAY OF DOUBLEPRECISION;
* ldc : INTEGER4);
*)
<* IF (__OPENMP__) THEN *>
CONST dgemm = LibDBlasL3F77.dgemmOMP;
<* ELSE *>
CONST dgemm = LibDBlasL3F77.dgemm;
<* END *>
(*----------------------------------------------------------------*)
(* Aufruf der Fortran Version von BLAS3 subroutine dgemm *)
(* ueber Schnittstelle die fuer eine korrekte Umsetzung der *)
(* Parameter sorgt. *)
(* Durch die Schnittstelle wird auch erreicht dass die Routine *)
(* "normal" aufgerufen werden kann wie von Modula-2 her gewoehnt *)
(* *)
(* Real matrix matrix multiplication routine *)
(* *)
(* TA : Specifies whether to transpose matrix A *)
(* TB : Specifies whether to transpose matrix B *)
(* M : Number of rows in matrices A and C *)
(* N : Number of columns in matrices B and C *)
(* K : Number of columns in matrix A; number of rows in *)
(* matrix B *)
(* Alpha : Scaling factor for the product of matrices A and B *)
(* A : Matrix A *)
(* lda : The size of the first dimention of matrix A, if *)
(* passing a matrix A[m,n], the value should be m *)
(* B : Matrix B *)
(* ldb : The size of the first dimention of matrix B, if *)
(* passing a matrix B[m,n], the value should be m *)
(* Beta : Scaling factor for matrix C *)
(* C : Resulting matrix C *)
(* ldb : The size of the first dimention of matrix C, if *)
(* passing a matrix C[m,n], the value should be m *)
(*----------------------------------------------------------------*)
(*=========================== Complex valued procedures ====================*)
(*
* PROCEDURE zswap(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncX : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncY : INTEGER4);
*)
CONST zswap = LibDBlasL1F77.zswap_;
(*----------------------------------------------------------------*)
(* Swap complex vectors X and Y *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE zcopy(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncX : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncY : INTEGER4);
*)
CONST zcopy = LibDBlasL1F77.zcopy_;
(*----------------------------------------------------------------*)
(* copies a vector, x, to a vector, y. *)
(* uses unrolled loops for increments equal to one. *)
(* jack dongarra, linpack, 3/11/78. *)
(* MRi, Modula-2 10.04.16 | 09.09.18 (complex version) *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE zdotc(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncX : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncY : INTEGER4) : DOUBLECOMPLEX;
*)
CONST zdotc = LibDBlasL1F77.zdotc_;
(*----------------------------------------------------------------*)
(* Forms the dot product of two vectors. Uses unrolled loops for *)
(* increments equal to one. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE dznrm2(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncX : INTEGER4) : DOUBLEPRECISION;
*)
CONST dznrm2 = LibDBlasL1F77.dznrm2_;
(*----------------------------------------------------------------*)
(* dznrm2 returns the euclidean norm of a vector so that *)
(* dznrm2 := sqrt( X**H*X ) *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE zscal(VAR n : INTEGER4;
* VAR da : DOUBLECOMPLEX;
* VAR dx : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncX : INTEGER4);
*)
CONST zscal = LibDBlasL1F77.zscal_;
(*----------------------------------------------------------------*)
(* Scales a vector by a constant (UNROLLED version) *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE zaxpy(VAR n : INTEGER4;
* VAR da : DOUBLECOMPLEX;
* VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncX : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncY : INTEGER4);
*)
CONST zaxpy = LibDBlasL1F77.zaxpy_;
(*----------------------------------------------------------------*)
(* constant times a vector plus a vector *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE zdrot(VAR N : INTEGER4;
* VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncX : INTEGER4;
* VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
* VAR IncY : INTEGER4;
* VAR c,s : REAL4);
*)
CONST zdrot = LibDBlasL1F77.zdrot_;
(*----------------------------------------------------------------*)
(* Applies a plane rotation. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE zgemv( Trans : CHAR;
* M,N : INTEGER;
* Alpha : LONGCOMPLEX;
* VAR A : ARRAY OF ARRAY OF LONGCOMPLEX;
* lda : INTEGER;
* VAR X : ARRAY OF LONGCOMPLEX;
* IncX : INTEGER;
* Beta : LONGCOMPLEX;
* VAR Y : ARRAY OF LONGCOMPLEX;
* IncY : INTEGER);
*)
CONST zgemv = LibDBlasL2F77.zgemv;
(*----------------------------------------------------------------*)
(* Aufruf der Fortran Version von BLAS2 subroutine zgemv *)
(* ueber Schnittstelle die fuer eine korrekte Umsetzung der *)
(* Parameter sorgt. *)
(* Durch die Schnittstelle wird auch erreicht dass die Routine *)
(* "normal" aufgerufen werden kann wie von Modula-2 her gewoehnt *)
(* *)
(* Performs one of the matrix-vector operations *)
(* *)
(* y = alpha*a *x + beta*y, or *)
(* y = alpha*a'*x + beta*y, or; *)
(* y = alpha*conjg(a')*x + beta*y,; *)
(* *)
(* where Alpha and Beta are scalars, X and Y are vectors *)
(* and A is an M by N matrix. *)
(*----------------------------------------------------------------*)
(*
* PROCEDURE zgemm( TA : CHAR1;
* TB : CHAR1;
* M,N,K : INTEGER4;
* Alpha : DOUBLECOMPLEX;
* VAR A : ARRAY OF ARRAY OF DOUBLECOMPLEX;
* lda : INTEGER4;
* VAR B : ARRAY OF ARRAY OF DOUBLECOMPLEX;
* ldb : INTEGER4;
* Beta : DOUBLECOMPLEX;
* VAR C : ARRAY OF ARRAY OF DOUBLECOMPLEX;
* ldc : INTEGER4);
*)
CONST zgemm = LibDBlasL3F77.zgemm;
(*----------------------------------------------------------------*)
(* Aufruf der Fortran Version von BLAS3 subroutine zgemm *)
(* ueber Schnittstelle die fuer eine korrekte Umsetzung der *)
(* Parameter sorgt. *)
(* Durch die Schnittstelle wird auch erreicht dass die Routine *)
(* "normal" aufgerufen werden kann wie von Modula-2 her gewoehnt *)
(* *)
(* Complex matrix matrix multiplication routine *)
(* *)
(* TA : Specifies whether to transpose matrix A (option "T") *)
(* or not (option "N") or use the complex conjugate of *)
(* the transpose of A (option "T", op(A) = conj(A')) *)
(* TB : Same as TA for matrix B *)
(* M : Number of rows in matrices A and C *)
(* N : Number of columns in matrices B and C *)
(* K : Number of columns in matrix A; number of rows in *)
(* matrix B *)
(* Alpha : Scaling factor for the product of matrices A and B *)
(* A : Matrix A *)
(* lda : The size of the first dimention of matrix A, if *)
(* passing a matrix A[m,n], the value should be m *)
(* B : Matrix B *)
(* ldb : The size of the first dimention of matrix B, if *)
(* passing a matrix B[m,n], the value should be m *)
(* Beta : Scaling factor for matrix C *)
(* C : Resulting matrix C *)
(* ldb : The size of the first dimention of matrix C, if *)
(* passing a matrix C[m,n], the value should be m *)
(*----------------------------------------------------------------*)
END LibDBlasF77.