Parent:
[c4be1a]
(diff)
Download this file
LibDBlasL1F77.def.m2pp
302 lines (255 with data), 15.6 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 *)
(* *)
(* * zswap : Swap complex vectors X and Y *)
(* * zcopy : copies a vector, x, to a vector, y. *)
(* * zdotu : Forms the dot product of two vectors. *)
(* * zdotc : Forms the dot product of two vectors *)
(* * dznrm2 : dznrm2 returns the euclidean norm of a vector *)
(* * zscal : Scales a vector by a constant *)
(* * zaxpy : constant times a vector plus a vector *)
(* zdrot : plane rotation *)
(*------------------------------------------------------------------------*)
(* 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 REAL8 to *)
(* (* ARRAY OF *) REAL8 *)
(* 01.11.17, MRi: Added idamin, made preprocessor interface *)
(* 01.02.19, MRi: Renamed DOUBLEPRECISION to REAL8, DOUBLE COMPLEX TO *)
(* COMPLEX16 - all other modules now refer to that *)
(* Change GM2 types for floating point number back to *)
(* incorrect types - Fortran BLAS cannot be linked *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: LibDBlasL1F77.def.m2pp,v 1.7 2019/02/01 22:48:19 mriedl Exp mriedl $ *)
<* IF (__XDS__) THEN *>
CONST Version = "LibDBlasL1F77 for XDS Modula-2";
TYPE REAL8 = LONGREAL;
COMPLEX16 = LONGCOMPLEX;
REAL4 = REAL;
INTEGER4 = LONGINT;
<* END *>
<* IF (__GM2__) THEN *>
CONST Version = "LibDBlasL1F77 for GNU Modula-2";
TYPE REAL8 = LONGREAL; (* REAL Untested !!! *)
COMPLEX16 = LONGCOMPLEX; (* Untested !!! *)
REAL4 = SHORTREAL;
INTEGER4 = INTEGER;
<* END *>
<* IF (__MOCKA__) THEN *>
CONST Version = "LibDBlasL1F77 for GMD Mocka";
TYPE REAL8 = LONGREAL;
REAL4 = REAL;
INTEGER4 = LONGINT;
<* END *>
CHAR1 = CHAR;
PROCEDURE dnrm2_(VAR n : INTEGER4;
VAR X : (* ARRAY OF *) REAL8;
VAR IncX : INTEGER4): REAL8;
(*----------------------------------------------------------------*)
(* 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 *) REAL8;
VAR incx : INTEGER4;
VAR Y : (* ARRAY OF *) REAL8;
VAR incy : INTEGER4);
(*----------------------------------------------------------------*)
(* Interchanges two vectors using unrolled loops for increments *)
(* equal to 1. *)
(*----------------------------------------------------------------*)
PROCEDURE dcopy_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) REAL8;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) REAL8;
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 *) REAL8;
VAR incX : INTEGER4;
VAR Y : (* ARRAY OF *) REAL8;
VAR incY : INTEGER4;
VAR c,s : REAL8);
(*---------------------------------------------------------------*)
(* Applies a plane rotation. *)
(* Jack Dongarra, linpack, 3/11/78. *)
(*---------------------------------------------------------------*)
PROCEDURE drotg_(VAR da : REAL8;
VAR db : REAL8;
VAR c : REAL8;
VAR s : REAL8);
(*---------------------------------------------------------------*)
(* Construct a Givens plane rotation *)
(* Jack Dongarra, linpack, 3/11/78. *)
(*---------------------------------------------------------------*)
PROCEDURE dscal_(VAR n : INTEGER4;
VAR da : REAL8;
VAR dx : (* ARRAY OF *) REAL8;
VAR incx : INTEGER4);
(*----------------------------------------------------------------*)
(* Scales a vector by a constant *)
(*----------------------------------------------------------------*)
PROCEDURE daxpy_(VAR n : INTEGER4;
VAR da : REAL8;
VAR dx : (* ARRAY OF *) REAL8;
VAR incx : INTEGER4;
VAR dy : (* ARRAY OF *) REAL8;
VAR incy : INTEGER4);
(*----------------------------------------------------------------*)
(* Constant times a vector plus a vector *)
(*----------------------------------------------------------------*)
PROCEDURE ddot_(VAR N : INTEGER4;
VAR DX : (* ARRAY OF *) REAL8;
VAR INCX : INTEGER4;
VAR DY : (* ARRAY OF *) REAL8;
VAR INCY : INTEGER4) : REAL8;
(*----------------------------------------------------------------*)
(* Forms the dot product of two vectors *)
(*----------------------------------------------------------------*)
PROCEDURE idamax_(VAR n : INTEGER4;
VAR dx : (* ARRAY OF *) REAL8;
VAR incx : INTEGER4) : INTEGER4;
(*----------------------------------------------------------------*)
(* Finds the index of element having max. absolute value. *)
(*----------------------------------------------------------------*)
PROCEDURE idamin_(VAR n : INTEGER4;
VAR dx : (* ARRAY OF *) REAL8;
VAR incx : INTEGER4) : INTEGER4;
(*----------------------------------------------------------------*)
(* Finds the index of element having min. absolute value. *)
(*----------------------------------------------------------------*)
PROCEDURE dasum_(VAR dim : INTEGER4;
VAR X : (* ARRAY OF *) REAL8;
VAR Inc : INTEGER4) : REAL8;
(*----------------------------------------------------------------*)
(* 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 *) COMPLEX16;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) COMPLEX16;
VAR IncY : INTEGER4);
(*----------------------------------------------------------------*)
(* Swap complex vectors X and Y *)
(*----------------------------------------------------------------*)
PROCEDURE zcopy_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) COMPLEX16;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) COMPLEX16;
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 zdotu_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) COMPLEX16;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) COMPLEX16;
VAR IncY : INTEGER4) : COMPLEX16;
(*----------------------------------------------------------------*)
(* Forms the dot product of two vectors. Uses unrolled loops for *)
(* increments equal to one. *)
(*----------------------------------------------------------------*)
PROCEDURE zdotc_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) COMPLEX16;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) COMPLEX16;
VAR IncY : INTEGER4) : COMPLEX16;
(*----------------------------------------------------------------*)
(* Forms the dot product of two vectors conj(X)*Y *)
(* Uses unrolled loops for increments equal to one. *)
(*----------------------------------------------------------------*)
PROCEDURE dznrm2_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) COMPLEX16;
VAR IncX : INTEGER4) : REAL8;
(*----------------------------------------------------------------*)
(* dznrm2 returns the euclidean norm of a vector so that *)
(* dznrm2 := sqrt( X**H*X ) *)
(*----------------------------------------------------------------*)
PROCEDURE zscal_(VAR n : INTEGER4;
VAR da : COMPLEX16;
VAR dx : (* ARRAY OF *) COMPLEX16;
VAR IncX : INTEGER4);
(*----------------------------------------------------------------*)
(* Scales a vector by a constant (UNROLLED version) *)
(*----------------------------------------------------------------*)
PROCEDURE zaxpy_(VAR n : INTEGER4;
VAR da : COMPLEX16;
VAR X : (* ARRAY OF *) COMPLEX16;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) COMPLEX16;
VAR IncY : INTEGER4);
(*----------------------------------------------------------------*)
(* constant times a vector plus a vector *)
(*----------------------------------------------------------------*)
PROCEDURE zdrot_(VAR N : INTEGER4;
VAR X : (* ARRAY OF *) COMPLEX16;
VAR IncX : INTEGER4;
VAR Y : (* ARRAY OF *) COMPLEX16;
VAR IncY : INTEGER4;
VAR c,s : REAL4);
(*----------------------------------------------------------------*)
(* Applies a plane rotation. *)
(*----------------------------------------------------------------*)
END LibDBlasL1F77.