|
a/LibDBlasL1F77.def.m2pp |
|
b/LibDBlasL1F77.def.m2pp |
|
... |
|
... |
| 58 |
(*------------------------------------------------------------------------*)
|
58 |
(*------------------------------------------------------------------------*)
|
| 59 |
(* Implementation : Michael Riedl *)
|
59 |
(* Implementation : Michael Riedl *)
|
| 60 |
(* Licence : GNU Lesser General Public License (LGPL) *)
|
60 |
(* Licence : GNU Lesser General Public License (LGPL) *)
|
| 61 |
(*------------------------------------------------------------------------*)
|
61 |
(*------------------------------------------------------------------------*)
|
| 62 |
|
62 |
|
| 63 |
(* $Id: LibDBlasL1F77.def.m2pp,v 1.3 2018/01/16 09:19:51 mriedl Exp mriedl $ *)
|
63 |
(* $Id: LibDBlasL1F77.def.m2pp,v 1.5 2018/09/12 13:20:49 mriedl Exp mriedl $ *)
|
| 64 |
|
64 |
|
| 65 |
<* IF (__XDS__) THEN *>
|
65 |
<* IF (__XDS__) THEN *>
|
| 66 |
CONST Version = "LibDBlasL1F77 for XDS Modula-2";
|
66 |
CONST Version = "LibDBlasL1F77 for XDS Modula-2";
|
| 67 |
|
67 |
|
| 68 |
TYPE DOUBLEPRECISION = LONGREAL;
|
68 |
TYPE DOUBLEPRECISION = LONGREAL;
|
|
... |
|
... |
| 196 |
(* erten Zahlen. *)
|
196 |
(* erten Zahlen. *)
|
| 197 |
(* *)
|
197 |
(* *)
|
| 198 |
(* Calculated the sum of absolute values stored in field X *)
|
198 |
(* Calculated the sum of absolute values stored in field X *)
|
| 199 |
(*----------------------------------------------------------------*)
|
199 |
(*----------------------------------------------------------------*)
|
| 200 |
|
200 |
|
|
|
201 |
(*=========================== Complex valued procedures ====================*)
|
|
|
202 |
|
|
|
203 |
PROCEDURE zswap_(VAR N : INTEGER4;
|
|
|
204 |
VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
205 |
VAR IncX : INTEGER4;
|
|
|
206 |
VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
207 |
VAR IncY : INTEGER4);
|
|
|
208 |
|
|
|
209 |
(*----------------------------------------------------------------*)
|
|
|
210 |
(* Swap complex vectors X and Y *)
|
|
|
211 |
(*----------------------------------------------------------------*)
|
|
|
212 |
|
|
|
213 |
PROCEDURE zcopy_(VAR N : INTEGER4;
|
|
|
214 |
VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
215 |
VAR IncX : INTEGER4;
|
|
|
216 |
VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
217 |
VAR IncY : INTEGER4);
|
|
|
218 |
|
|
|
219 |
(*----------------------------------------------------------------*)
|
|
|
220 |
(* copies a vector, x, to a vector, y. *)
|
|
|
221 |
(* uses unrolled loops for increments equal to one. *)
|
|
|
222 |
(* jack dongarra, linpack, 3/11/78. *)
|
|
|
223 |
(* MRi, Modula-2 10.04.16 | 09.09.18 (complex version) *)
|
|
|
224 |
(*----------------------------------------------------------------*)
|
|
|
225 |
|
|
|
226 |
PROCEDURE zdotc_(VAR N : INTEGER4;
|
|
|
227 |
VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
228 |
VAR IncX : INTEGER4;
|
|
|
229 |
VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
230 |
VAR IncY : INTEGER4) : DOUBLECOMPLEX;
|
|
|
231 |
|
|
|
232 |
(*----------------------------------------------------------------*)
|
|
|
233 |
(* Forms the dot product of two vectors. Uses unrolled loops for *)
|
|
|
234 |
(* increments equal to one. *)
|
|
|
235 |
(*----------------------------------------------------------------*)
|
|
|
236 |
|
|
|
237 |
PROCEDURE dznrm2_(VAR N : INTEGER4;
|
|
|
238 |
VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
239 |
VAR IncX : INTEGER4) : DOUBLEPRECISION;
|
|
|
240 |
|
|
|
241 |
(*----------------------------------------------------------------*)
|
|
|
242 |
(* dznrm2 returns the euclidean norm of a vector so that *)
|
|
|
243 |
(* dznrm2 := sqrt( X**H*X ) *)
|
|
|
244 |
(*----------------------------------------------------------------*)
|
|
|
245 |
|
|
|
246 |
PROCEDURE zscal_(VAR n : INTEGER4;
|
|
|
247 |
VAR da : DOUBLECOMPLEX;
|
|
|
248 |
VAR dx : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
249 |
VAR IncX : INTEGER4);
|
|
|
250 |
|
|
|
251 |
(*----------------------------------------------------------------*)
|
|
|
252 |
(* Scales a vector by a constant (UNROLLED version) *)
|
|
|
253 |
(*----------------------------------------------------------------*)
|
|
|
254 |
|
|
|
255 |
PROCEDURE zaxpy_(VAR n : INTEGER4;
|
|
|
256 |
VAR da : DOUBLECOMPLEX;
|
|
|
257 |
VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
258 |
VAR IncX : INTEGER4;
|
|
|
259 |
VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
260 |
VAR IncY : INTEGER4);
|
|
|
261 |
|
|
|
262 |
(*----------------------------------------------------------------*)
|
|
|
263 |
(* constant times a vector plus a vector *)
|
|
|
264 |
(*----------------------------------------------------------------*)
|
|
|
265 |
|
|
|
266 |
PROCEDURE zdrot_(VAR N : INTEGER4;
|
|
|
267 |
VAR X : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
268 |
VAR IncX : INTEGER4;
|
|
|
269 |
VAR Y : (* ARRAY OF *) DOUBLECOMPLEX;
|
|
|
270 |
VAR IncY : INTEGER4;
|
|
|
271 |
VAR c,s : REAL4);
|
|
|
272 |
|
|
|
273 |
(*----------------------------------------------------------------*)
|
|
|
274 |
(* Applies a plane rotation. *)
|
|
|
275 |
(*----------------------------------------------------------------*)
|
|
|
276 |
|
| 201 |
END LibDBlasL1F77.
|
277 |
END LibDBlasL1F77.
|