Parent:
[3b207b]
(diff)
Child:
[28b809]
(diff)
Download this file
LibDBlasL1F77.def.m2pp
278 lines (233 with data), 14.4 kB
<* IF (__XDS__) THEN *>
DEFINITION MODULE ["C"] LibDBlasL1F77; (* XDS *)
<* END *>
<* IF (__GM2__) THEN *>
DEFINITION MODULE FOR "C" LibDBlasL1F77; (* GNU M2 *)
<* END *>
<* IF (__MOCKA__) THEN *>
FOREIGN MODULE LibDBlasL1F77; (* Mocka *)
<* END *>
(*========================================================================*)
(* WICHTIG: BITTE NUR DIE DATEI LibDBlasL1F77.def.m2pp EDITIEREN !!! *)
(*========================================================================*)
(* Es sind 3 Versionen enthalten die mit *)
(* *)
(* m2pp -D __{Parameter}__ < LibDBlasL1F77.mod.m2pp > LibDBlasL1F77.mod *)
(* *)
(* mit Parameter = {XDS|GM2|MOCKA} erzeugt werden koennen. *)
(* *)
(* GM2 : Definitionsmodul im Stil des GM2 M2 Compilers *)
(* XDS : Definitionsmodul im Stil des XDS M2 Compilers *)
(* Mocka : Definitionsmodul im Stil des Mocka Compilers *)
(* *)
(* ansonsten gibt es keine Aenderungen am Quellcode *)
(* *)
(* There are three version contained, one for the GNU, XDS and Mocka *)
(* compiler which can be produced by the m2pp command line given above *)
(*------------------------------------------------------------------------*)
(* Schnittstelle zu blas level 1 FORTRAN 77 subroutinen. *)
(* Interface to dblas level 1 FORTRAN 77 subroutines. *)
(* *)
(* Jack Dongarra, linpack, 3/11/78. *)
(* *)
(* To Do: Lot of other routines ;-) *)
(* *)
(* Routine provided so far are: *)
(* *)
(* 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 *)
(*------------------------------------------------------------------------*)
(* 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 *)
(* 01.11.17, MRi: Added idamin, made preprocessor interface *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: LibDBlasL1F77.def.m2pp,v 1.5 2018/09/12 13:20:49 mriedl Exp mriedl $ *)
<* IF (__XDS__) THEN *>
CONST Version = "LibDBlasL1F77 for XDS Modula-2";
TYPE DOUBLEPRECISION = LONGREAL;
DOUBLECOMPLEX = LONGCOMPLEX;
REAL4 = REAL;
INTEGER4 = LONGINT;
<* END *>
<* IF (__GM2__) THEN *>
CONST Version = "LibDBlasL1F77 for GNU Modula-2";
TYPE DOUBLEPRECISION = REAL; (* Untested !!! *)
DOUBLECOMPLEX = COMPLEX; (* Untested !!! *)
REAL4 = SHORTREAL;
INTEGER4 = INTEGER;
<* END *>
<* IF (__MOCKA__) THEN *>
CONST Version = "LibDBlasL1F77 for GMD Mocka";
TYPE DOUBLEPRECISION = LONGREAL;
REAL4 = REAL;
INTEGER4 = LONGINT;
<* END *>
CHAR1 = CHAR;
PROCEDURE dnrm2_(VAR n : INTEGER4;
VAR X : (* ARRAY OF *) DOUBLEPRECISION;
VAR IncX : INTEGER4): DOUBLEPRECISION;
(*----------------------------------------------------------------*)
(* dnrm2 returns the euclidean norm of a vector via the function *)
(* name, so that dnrm2 := sqrt( x'*x ) *)
(*----------------------------------------------------------------*)
PROCEDURE dswap_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) DOUBLEPRECISION;
VAR incx : INTEGER4;
VAR Y : (* ARRAY OF *) DOUBLEPRECISION;
VAR incy : INTEGER4);
(*----------------------------------------------------------------*)
(* 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);
(*----------------------------------------------------------------*)
(* 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);
(*---------------------------------------------------------------*)
(* Applies a plane rotation. *)
(* Jack Dongarra, linpack, 3/11/78. *)
(*---------------------------------------------------------------*)
PROCEDURE drotg_(VAR da : DOUBLEPRECISION;
VAR db : DOUBLEPRECISION;
VAR c : DOUBLEPRECISION;
VAR s : DOUBLEPRECISION);
(*---------------------------------------------------------------*)
(* 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);
(*----------------------------------------------------------------*)
(* 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);
(*----------------------------------------------------------------*)
(* 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;
(*----------------------------------------------------------------*)
(* Forms the dot product of two vectors *)
(*----------------------------------------------------------------*)
PROCEDURE idamax_(VAR n : INTEGER4;
VAR dx : (* ARRAY OF *) DOUBLEPRECISION;
VAR incx : INTEGER4) : INTEGER4;
(*----------------------------------------------------------------*)
(* Finds the index of element having max. absolute value. *)
(*----------------------------------------------------------------*)
PROCEDURE idamin_(VAR n : INTEGER4;
VAR dx : (* ARRAY OF *) DOUBLEPRECISION;
VAR incx : INTEGER4) : INTEGER4;
(*----------------------------------------------------------------*)
(* Finds the index of element having min. absolute value. *)
(*----------------------------------------------------------------*)
PROCEDURE dasum_(VAR dim : INTEGER4;
VAR X : (* ARRAY OF *) DOUBLEPRECISION;
VAR Inc : INTEGER4) : DOUBLEPRECISION;
(*----------------------------------------------------------------*)
(* Berechnet die Summe der Absolutwerte der im Feld X gespeich- *)
(* erten Zahlen. *)
(* *)
(* Calculated the sum of absolute values stored in field X *)
(*----------------------------------------------------------------*)
(*=========================== Complex valued procedures ====================*)
PROCEDURE zswap_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
VAR IncY : INTEGER4);
(*----------------------------------------------------------------*)
(* 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);
(*----------------------------------------------------------------*)
(* 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;
(*----------------------------------------------------------------*)
(* 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;
(*----------------------------------------------------------------*)
(* 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);
(*----------------------------------------------------------------*)
(* 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);
(*----------------------------------------------------------------*)
(* 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);
(*----------------------------------------------------------------*)
(* Applies a plane rotation. *)
(*----------------------------------------------------------------*)
END LibDBlasL1F77.