|
a/LibDBlasM2.def |
|
b/LibDBlasM2.def |
|
... |
|
... |
| 43 |
(* ENorm : Euklidian norm of a vector *)
|
43 |
(* ENorm : Euklidian norm of a vector *)
|
| 44 |
(*------------------------------------------------------------------------*)
|
44 |
(*------------------------------------------------------------------------*)
|
| 45 |
|
45 |
|
| 46 |
(* $Id: LibDBlasM2.def,v 1.12 2018/09/12 13:20:49 mriedl Exp mriedl $ *)
|
46 |
(* $Id: LibDBlasM2.def,v 1.12 2018/09/12 13:20:49 mriedl Exp mriedl $ *)
|
| 47 |
|
47 |
|
| 48 |
FROM Deklera IMPORT FLOAT,CFLOAT; (* REAL/COMPLEX Type *)
|
48 |
FROM F77func IMPORT REAL8,COMPLEX16; (* REAL/COMPLEX Type *)
|
| 49 |
|
49 |
|
| 50 |
PROCEDURE SumVek(VAR X : ARRAY OF FLOAT;
|
50 |
PROCEDURE SumVek(VAR X : ARRAY OF REAL8;
|
| 51 |
s,e : CARDINAL) : FLOAT;
|
51 |
s,e : CARDINAL) : REAL8;
|
| 52 |
|
52 |
|
| 53 |
(*----------------------------------------------------------------*)
|
53 |
(*----------------------------------------------------------------*)
|
| 54 |
(* Berechnet \sum_{i=s}^e X_i, wobei der erste (m"ogliche) *)
|
54 |
(* Berechnet \sum_{i=s}^e X_i, wobei der erste (m"ogliche) *)
|
| 55 |
(* Index 1 ist. *)
|
55 |
(* Index 1 ist. *)
|
| 56 |
(* *)
|
56 |
(* *)
|
|
... |
|
... |
| 58 |
(* Sehr pr"aziser, aber aufwendiger Summationsalgorithmus. *)
|
58 |
(* Sehr pr"aziser, aber aufwendiger Summationsalgorithmus. *)
|
| 59 |
(* Vorsicht bei einigen Optimierer, es kann sein, da3 das berech- *)
|
59 |
(* Vorsicht bei einigen Optimierer, es kann sein, da3 das berech- *)
|
| 60 |
(* nete "gard-digit" (c) wegoptimiert wird !!! *)
|
60 |
(* nete "gard-digit" (c) wegoptimiert wird !!! *)
|
| 61 |
(*----------------------------------------------------------------*)
|
61 |
(*----------------------------------------------------------------*)
|
| 62 |
|
62 |
|
| 63 |
PROCEDURE AbsSumVek(VAR X : ARRAY OF FLOAT;
|
63 |
PROCEDURE AbsSumVek(VAR X : ARRAY OF REAL8;
|
| 64 |
s,e : CARDINAL) : FLOAT;
|
64 |
s,e : CARDINAL) : REAL8;
|
| 65 |
|
65 |
|
| 66 |
(*----------------------------------------------------------------*)
|
66 |
(*----------------------------------------------------------------*)
|
| 67 |
(* Berechnet \sum_{i=s}^e |X_i|, wobei der erste (m"ogliche) *)
|
67 |
(* Berechnet \sum_{i=s}^e |X_i|, wobei der erste (m"ogliche) *)
|
| 68 |
(* Index 1 ist. *)
|
68 |
(* Index 1 ist. *)
|
| 69 |
(* Bis auf die Absolutwerte identisch mit SumVek. *)
|
69 |
(* Bis auf die Absolutwerte identisch mit SumVek. *)
|
| 70 |
(*----------------------------------------------------------------*)
|
70 |
(*----------------------------------------------------------------*)
|
| 71 |
|
71 |
|
| 72 |
PROCEDURE ENorm(VAR X : ARRAY OF FLOAT;
|
72 |
PROCEDURE ENorm(VAR X : ARRAY OF REAL8;
|
| 73 |
s,e : CARDINAL) : FLOAT;
|
73 |
s,e : CARDINAL) : REAL8;
|
| 74 |
|
74 |
|
| 75 |
(*----------------------------------------------------------------*)
|
75 |
(*----------------------------------------------------------------*)
|
| 76 |
(* Berechnet \sqrt{ \sum_{i=s}^e X_i^2} , wobei der erste *)
|
76 |
(* Berechnet \sqrt{ \sum_{i=s}^e X_i^2} , wobei der erste *)
|
| 77 |
(* (m"ogliche) Index s=1 ist. *)
|
77 |
(* (m"ogliche) Index s=1 ist. *)
|
| 78 |
(* *)
|
78 |
(* *)
|
|
... |
|
... |
| 94 |
(* Anpassung an Modula-2 und "Uberarbeitung : M.Riedl, 23.11.93. *)
|
94 |
(* Anpassung an Modula-2 und "Uberarbeitung : M.Riedl, 23.11.93. *)
|
| 95 |
(* Berechnet \sqrt{ \sum_{i=s}^e X_i^2} *)
|
95 |
(* Berechnet \sqrt{ \sum_{i=s}^e X_i^2} *)
|
| 96 |
(*----------------------------------------------------------------*)
|
96 |
(*----------------------------------------------------------------*)
|
| 97 |
|
97 |
|
| 98 |
PROCEDURE dnrm2( n : INTEGER;
|
98 |
PROCEDURE dnrm2( n : INTEGER;
|
| 99 |
VAR X : ARRAY OF FLOAT;
|
99 |
VAR X : ARRAY OF REAL8;
|
| 100 |
IncX : INTEGER): FLOAT;
|
100 |
IncX : INTEGER): REAL8;
|
| 101 |
|
101 |
|
| 102 |
(*----------------------------------------------------------------*)
|
102 |
(*----------------------------------------------------------------*)
|
| 103 |
(* dnrm2 returns the euclidean norm of a vector via the function *)
|
103 |
(* dnrm2 returns the euclidean norm of a vector via the function *)
|
| 104 |
(* name, so that dnrm2 := sqrt( x'*x ) *)
|
104 |
(* name, so that dnrm2 := sqrt( x'*x ) *)
|
| 105 |
(*----------------------------------------------------------------*)
|
105 |
(*----------------------------------------------------------------*)
|
| 106 |
|
106 |
|
| 107 |
PROCEDURE dswap( N : CARDINAL;
|
107 |
PROCEDURE dswap( N : CARDINAL;
|
| 108 |
VAR X : ARRAY OF FLOAT;
|
108 |
VAR X : ARRAY OF REAL8;
|
| 109 |
incX : INTEGER;
|
109 |
incX : INTEGER;
|
| 110 |
VAR Y : ARRAY OF FLOAT;
|
110 |
VAR Y : ARRAY OF REAL8;
|
| 111 |
incY : INTEGER);
|
111 |
incY : INTEGER);
|
| 112 |
|
112 |
|
| 113 |
(*----------------------------------------------------------------*)
|
113 |
(*----------------------------------------------------------------*)
|
| 114 |
(* Interchanges two vectors using unrolled loops for increments *)
|
114 |
(* Interchanges two vectors using unrolled loops for increments *)
|
| 115 |
(* equal to 1. *)
|
115 |
(* equal to 1. *)
|
| 116 |
(*----------------------------------------------------------------*)
|
116 |
(*----------------------------------------------------------------*)
|
| 117 |
|
117 |
|
| 118 |
PROCEDURE dcopy( N : INTEGER;
|
118 |
PROCEDURE dcopy( N : INTEGER;
|
| 119 |
VAR X : ARRAY OF FLOAT;
|
119 |
VAR X : ARRAY OF REAL8;
|
| 120 |
IncX : INTEGER;
|
120 |
IncX : INTEGER;
|
| 121 |
VAR Y : ARRAY OF FLOAT;
|
121 |
VAR Y : ARRAY OF REAL8;
|
| 122 |
IncY : INTEGER);
|
122 |
IncY : INTEGER);
|
| 123 |
|
123 |
|
| 124 |
(*----------------------------------------------------------------*)
|
124 |
(*----------------------------------------------------------------*)
|
| 125 |
(* copies a vector, X, to a vector, Y. *)
|
125 |
(* copies a vector, X, to a vector, Y. *)
|
| 126 |
(* uses unrolled loops for increments equal to one. *)
|
126 |
(* uses unrolled loops for increments equal to one. *)
|
| 127 |
(* jack dongarra, linpack, 3/11/78. *)
|
127 |
(* jack dongarra, linpack, 3/11/78. *)
|
| 128 |
(* MRi, Modula-2 10.04.16 *)
|
128 |
(* MRi, Modula-2 10.04.16 *)
|
| 129 |
(*----------------------------------------------------------------*)
|
129 |
(*----------------------------------------------------------------*)
|
| 130 |
|
130 |
|
| 131 |
PROCEDURE drot( N : INTEGER;
|
131 |
PROCEDURE drot( N : INTEGER;
|
| 132 |
VAR X : ARRAY OF FLOAT;
|
132 |
VAR X : ARRAY OF REAL8;
|
| 133 |
incX : INTEGER;
|
133 |
incX : INTEGER;
|
| 134 |
VAR Y : ARRAY OF FLOAT;
|
134 |
VAR Y : ARRAY OF REAL8;
|
| 135 |
incY : INTEGER;
|
135 |
incY : INTEGER;
|
| 136 |
c,s : FLOAT);
|
136 |
c,s : REAL8);
|
| 137 |
|
137 |
|
| 138 |
(*---------------------------------------------------------------*)
|
138 |
(*---------------------------------------------------------------*)
|
| 139 |
(* Applies a plane rotation. *)
|
139 |
(* Applies a plane rotation. *)
|
| 140 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
140 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
| 141 |
(*---------------------------------------------------------------*)
|
141 |
(*---------------------------------------------------------------*)
|
| 142 |
|
142 |
|
| 143 |
PROCEDURE drotg(VAR da : FLOAT;
|
143 |
PROCEDURE drotg(VAR da : REAL8;
|
| 144 |
VAR db : FLOAT;
|
144 |
VAR db : REAL8;
|
| 145 |
VAR c : FLOAT;
|
145 |
VAR c : REAL8;
|
| 146 |
VAR s : FLOAT);
|
146 |
VAR s : REAL8);
|
| 147 |
|
147 |
|
| 148 |
(*---------------------------------------------------------------*)
|
148 |
(*---------------------------------------------------------------*)
|
| 149 |
(* Construct a Givens plane rotation *)
|
149 |
(* Construct a Givens plane rotation *)
|
| 150 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
150 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
| 151 |
(*---------------------------------------------------------------*)
|
151 |
(*---------------------------------------------------------------*)
|
| 152 |
|
152 |
|
| 153 |
PROCEDURE dscal( n : INTEGER;
|
153 |
PROCEDURE dscal( n : INTEGER;
|
| 154 |
da : FLOAT;
|
154 |
da : REAL8;
|
| 155 |
VAR dx : ARRAY OF FLOAT;
|
155 |
VAR dx : ARRAY OF REAL8;
|
| 156 |
incx : INTEGER);
|
156 |
incx : INTEGER);
|
| 157 |
|
157 |
|
| 158 |
(*----------------------------------------------------------------*)
|
158 |
(*----------------------------------------------------------------*)
|
| 159 |
(* Scales a vector by a constant (UNROLLED version) *)
|
159 |
(* Scales a vector by a constant (UNROLLED version) *)
|
| 160 |
(* *)
|
160 |
(* *)
|
| 161 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
161 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
| 162 |
(*----------------------------------------------------------------*)
|
162 |
(*----------------------------------------------------------------*)
|
| 163 |
|
163 |
|
| 164 |
PROCEDURE daxpy( n : INTEGER;
|
164 |
PROCEDURE daxpy( n : INTEGER;
|
| 165 |
da : FLOAT;
|
165 |
da : REAL8;
|
| 166 |
VAR dx : ARRAY OF FLOAT;
|
166 |
VAR dx : ARRAY OF REAL8;
|
| 167 |
incx : INTEGER;
|
167 |
incx : INTEGER;
|
| 168 |
VAR dy : ARRAY OF FLOAT;
|
168 |
VAR dy : ARRAY OF REAL8;
|
| 169 |
incy : INTEGER);
|
169 |
incy : INTEGER);
|
| 170 |
|
170 |
|
| 171 |
(*----------------------------------------------------------------*)
|
171 |
(*----------------------------------------------------------------*)
|
| 172 |
(* constant times a vector plus a vector (UNROLLED version). *)
|
172 |
(* constant times a vector plus a vector (UNROLLED version). *)
|
| 173 |
(* *)
|
173 |
(* *)
|
| 174 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
174 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
| 175 |
(*----------------------------------------------------------------*)
|
175 |
(*----------------------------------------------------------------*)
|
| 176 |
|
176 |
|
| 177 |
PROCEDURE ddot( N : INTEGER;
|
177 |
PROCEDURE ddot( N : INTEGER;
|
| 178 |
VAR X : ARRAY OF FLOAT;
|
178 |
VAR X : ARRAY OF REAL8;
|
| 179 |
IncX : INTEGER;
|
179 |
IncX : INTEGER;
|
| 180 |
VAR Y : ARRAY OF FLOAT;
|
180 |
VAR Y : ARRAY OF REAL8;
|
| 181 |
IncY : INTEGER) : FLOAT;
|
181 |
IncY : INTEGER) : REAL8;
|
| 182 |
|
182 |
|
| 183 |
(*----------------------------------------------------------------*)
|
183 |
(*----------------------------------------------------------------*)
|
| 184 |
(* Forms the dot product of two vectors. Uses unrolled loops for *)
|
184 |
(* Forms the dot product of two vectors. Uses unrolled loops for *)
|
| 185 |
(* increments equal to one. *)
|
185 |
(* increments equal to one. *)
|
| 186 |
(* Implementation : Jack Dongarra, linpack, 3/11/78. *)
|
186 |
(* Implementation : Jack Dongarra, linpack, 3/11/78. *)
|
| 187 |
(* Adopted to Modula-2, MRi, 06.09.2015 *)
|
187 |
(* Adopted to Modula-2, MRi, 06.09.2015 *)
|
| 188 |
(*----------------------------------------------------------------*)
|
188 |
(*----------------------------------------------------------------*)
|
| 189 |
|
189 |
|
| 190 |
PROCEDURE idamax( n : INTEGER;
|
190 |
PROCEDURE idamax( n : INTEGER;
|
| 191 |
VAR dx : ARRAY OF FLOAT;
|
191 |
VAR dx : ARRAY OF REAL8;
|
| 192 |
incx : INTEGER) : INTEGER;
|
192 |
incx : INTEGER) : INTEGER;
|
| 193 |
|
193 |
|
| 194 |
(*----------------------------------------------------------------*)
|
194 |
(*----------------------------------------------------------------*)
|
| 195 |
(* Finds the index of element having max. absolute value. *)
|
195 |
(* Finds the index of element having max. absolute value. *)
|
| 196 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
196 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
| 197 |
(* Please note that indexing is starting with 0 on M2 open arrays *)
|
197 |
(* Please note that indexing is starting with 0 on M2 open arrays *)
|
| 198 |
(* so if X is declared [1..n] you need to add 1 to the result. *)
|
198 |
(* so if X is declared [1..n] you need to add 1 to the result. *)
|
| 199 |
(*----------------------------------------------------------------*)
|
199 |
(*----------------------------------------------------------------*)
|
| 200 |
|
200 |
|
| 201 |
PROCEDURE idamin( n : INTEGER;
|
201 |
PROCEDURE idamin( n : INTEGER;
|
| 202 |
VAR X : ARRAY OF FLOAT;
|
202 |
VAR X : ARRAY OF REAL8;
|
| 203 |
IncX : INTEGER) : INTEGER;
|
203 |
IncX : INTEGER) : INTEGER;
|
| 204 |
|
204 |
|
| 205 |
(*----------------------------------------------------------------*)
|
205 |
(*----------------------------------------------------------------*)
|
| 206 |
(* Finds the index of element having min. absolute value. *)
|
206 |
(* Finds the index of element having min. absolute value. *)
|
| 207 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
207 |
(* Jack Dongarra, linpack, 3/11/78. *)
|
|
... |
|
... |
| 210 |
(* result. This is done to be compatible with the calls to the *)
|
210 |
(* result. This is done to be compatible with the calls to the *)
|
| 211 |
(* Fortran equivalent routines. *)
|
211 |
(* Fortran equivalent routines. *)
|
| 212 |
(*----------------------------------------------------------------*)
|
212 |
(*----------------------------------------------------------------*)
|
| 213 |
|
213 |
|
| 214 |
PROCEDURE dasum( dim : CARDINAL;
|
214 |
PROCEDURE dasum( dim : CARDINAL;
|
| 215 |
VAR X : ARRAY OF FLOAT;
|
215 |
VAR X : ARRAY OF REAL8;
|
| 216 |
Inc : CARDINAL; (* Inkrementwert >= 1*)
|
216 |
Inc : CARDINAL; (* Inkrementwert >= 1*)
|
| 217 |
Unrolled : BOOLEAN) : FLOAT;
|
217 |
Unrolled : BOOLEAN) : REAL8;
|
| 218 |
|
218 |
|
| 219 |
(*----------------------------------------------------------------*)
|
219 |
(*----------------------------------------------------------------*)
|
| 220 |
(* Berechnet die Summe der Absolutwerte der im Feld X gespeich- *)
|
220 |
(* Berechnet die Summe der Absolutwerte der im Feld X gespeich- *)
|
| 221 |
(* erten Zahlen. *)
|
221 |
(* erten Zahlen. *)
|
| 222 |
(*----------------------------------------------------------------*)
|
222 |
(*----------------------------------------------------------------*)
|
| 223 |
|
223 |
|
| 224 |
PROCEDURE dgemv( Trans : CHAR;
|
224 |
PROCEDURE dgemv( Trans : CHAR;
|
| 225 |
M,N : INTEGER;
|
225 |
M,N : INTEGER;
|
| 226 |
Alpha : FLOAT;
|
226 |
Alpha : REAL8;
|
| 227 |
VAR A : ARRAY OF ARRAY OF FLOAT;
|
227 |
VAR A : ARRAY OF ARRAY OF REAL8;
|
| 228 |
LDA : INTEGER;
|
228 |
LDA : INTEGER;
|
| 229 |
VAR X : ARRAY OF FLOAT;
|
229 |
VAR X : ARRAY OF REAL8;
|
| 230 |
IncX : INTEGER;
|
230 |
IncX : INTEGER;
|
| 231 |
Beta : FLOAT;
|
231 |
Beta : REAL8;
|
| 232 |
VAR Y : ARRAY OF FLOAT;
|
232 |
VAR Y : ARRAY OF REAL8;
|
| 233 |
IncY : INTEGER);
|
233 |
IncY : INTEGER);
|
| 234 |
|
234 |
|
| 235 |
(*----------------------------------------------------------------*)
|
235 |
(*----------------------------------------------------------------*)
|
| 236 |
(* Purpose *)
|
236 |
(* Purpose *)
|
| 237 |
(* ======= *)
|
237 |
(* ======= *)
|
|
... |
|
... |
| 298 |
(* -- Portiert nach M2 von M. Riedl, August 1995. *)
|
298 |
(* -- Portiert nach M2 von M. Riedl, August 1995. *)
|
| 299 |
(*----------------------------------------------------------------*)
|
299 |
(*----------------------------------------------------------------*)
|
| 300 |
|
300 |
|
| 301 |
PROCEDURE dgemm( TransA,TransB : CHAR;
|
301 |
PROCEDURE dgemm( TransA,TransB : CHAR;
|
| 302 |
M,N,K : INTEGER;
|
302 |
M,N,K : INTEGER;
|
| 303 |
Alpha : FLOAT;
|
303 |
Alpha : REAL8;
|
| 304 |
VAR A : ARRAY OF ARRAY OF FLOAT;
|
304 |
VAR A : ARRAY OF ARRAY OF REAL8;
|
| 305 |
LDA : INTEGER;
|
305 |
LDA : INTEGER;
|
| 306 |
VAR B : ARRAY OF ARRAY OF FLOAT;
|
306 |
VAR B : ARRAY OF ARRAY OF REAL8;
|
| 307 |
LDB : INTEGER;
|
307 |
LDB : INTEGER;
|
| 308 |
Beta : FLOAT;
|
308 |
Beta : REAL8;
|
| 309 |
VAR C : ARRAY OF ARRAY OF FLOAT;
|
309 |
VAR C : ARRAY OF ARRAY OF REAL8;
|
| 310 |
LDC : INTEGER);
|
310 |
LDC : INTEGER);
|
| 311 |
|
311 |
|
| 312 |
(*----------------------------------------------------------------*)
|
312 |
(*----------------------------------------------------------------*)
|
| 313 |
(* Purpose *)
|
313 |
(* Purpose *)
|
| 314 |
(* ======= *)
|
314 |
(* ======= *)
|
|
... |
|
... |
| 350 |
(* matrix C. N must be at least zero. *)
|
350 |
(* matrix C. N must be at least zero. *)
|
| 351 |
(* K : On entry, K specifies the number of columns of the *)
|
351 |
(* K : On entry, K specifies the number of columns of the *)
|
| 352 |
(* matrix op( A ) and the number of rows of the matrix *)
|
352 |
(* matrix op( A ) and the number of rows of the matrix *)
|
| 353 |
(* op( B ). K must be at least zero. *)
|
353 |
(* op( B ). K must be at least zero. *)
|
| 354 |
(* Alpha : On entry, Alpha specifies the scalar alpha. *)
|
354 |
(* Alpha : On entry, Alpha specifies the scalar alpha. *)
|
| 355 |
(* A : FLOAT array of DIMENSION ( LDA, ka ), where ka is *)
|
355 |
(* A : REAL8 array of DIMENSION ( LDA, ka ), where ka is *)
|
| 356 |
(* k when TransA = 'N' or 'n', and is m otherwise. *)
|
356 |
(* k when TransA = 'N' or 'n', and is m otherwise. *)
|
| 357 |
(* Before entry with TransA = 'N' or 'n', the leading *)
|
357 |
(* Before entry with TransA = 'N' or 'n', the leading *)
|
| 358 |
(* m by k part of the array A must contain the matrix *)
|
358 |
(* m by k part of the array A must contain the matrix *)
|
| 359 |
(* A, otherwise the leading k by m part of the array *)
|
359 |
(* A, otherwise the leading k by m part of the array *)
|
| 360 |
(* A must contain the matrix A. *)
|
360 |
(* A must contain the matrix A. *)
|
| 361 |
(* Unchanged on exit. *)
|
361 |
(* Unchanged on exit. *)
|
| 362 |
(* LDA : On entry, LDA specifies the first dimension of A as *)
|
362 |
(* LDA : On entry, LDA specifies the first dimension of A as *)
|
| 363 |
(* declared in the calling (sub) program. When TransA = *)
|
363 |
(* declared in the calling (sub) program. When TransA = *)
|
| 364 |
(* 'N' or 'n' then LDA must be at least max( 1, m ), *)
|
364 |
(* 'N' or 'n' then LDA must be at least max( 1, m ), *)
|
| 365 |
(* otherwise LDA must be at least max( 1, k ). *)
|
365 |
(* otherwise LDA must be at least max( 1, k ). *)
|
| 366 |
(* B : FLOAT array of DIMENSION ( LDB, kb ), *)
|
366 |
(* B : REAL8 array of DIMENSION ( LDB, kb ), *)
|
| 367 |
(* where kb is n when TransB = 'N' or 'n', and is k *)
|
367 |
(* where kb is n when TransB = 'N' or 'n', and is k *)
|
| 368 |
(* otherwise. Before entry with TransB = 'N' or 'n', *)
|
368 |
(* otherwise. Before entry with TransB = 'N' or 'n', *)
|
| 369 |
(* the leading k by n part of the array B must *)
|
369 |
(* the leading k by n part of the array B must *)
|
| 370 |
(* contain the matrix B, otherwise the leading n by k *)
|
370 |
(* contain the matrix B, otherwise the leading n by k *)
|
| 371 |
(* part of the array B must contain the matrix B. *)
|
371 |
(* part of the array B must contain the matrix B. *)
|
|
... |
|
... |
| 374 |
(* declared in the calling (sub) program. When TransB = *)
|
374 |
(* declared in the calling (sub) program. When TransB = *)
|
| 375 |
(* 'N' or 'n' then LDB must be at least max( 1, k ), *)
|
375 |
(* 'N' or 'n' then LDB must be at least max( 1, k ), *)
|
| 376 |
(* otherwise LDB must be at least max( 1, n ). *)
|
376 |
(* otherwise LDB must be at least max( 1, n ). *)
|
| 377 |
(* Beta : On entry, Beta specifies the scalar beta. When Beta *)
|
377 |
(* Beta : On entry, Beta specifies the scalar beta. When Beta *)
|
| 378 |
(* is supplied as zero then C need not be set on input. *)
|
378 |
(* is supplied as zero then C need not be set on input. *)
|
| 379 |
(* C : FLOAT array of DIMENSION ( LDC, n ). *)
|
379 |
(* C : REAL8 array of DIMENSION ( LDC, n ). *)
|
| 380 |
(* Before entry, the leading m by n part of the array *)
|
380 |
(* Before entry, the leading m by n part of the array *)
|
| 381 |
(* C must contain the matrix C, except when beta is *)
|
381 |
(* C must contain the matrix C, except when beta is *)
|
| 382 |
(* zero, in which case C need not be set on entry. *)
|
382 |
(* zero, in which case C need not be set on entry. *)
|
| 383 |
(* On exit, the array C is overwritten by the m by n *)
|
383 |
(* On exit, the array C is overwritten by the m by n *)
|
| 384 |
(* matrix ( alpha*op( A )*op( B ) + beta*C ). *)
|
384 |
(* matrix ( alpha*op( A )*op( B ) + beta*C ). *)
|
|
... |
|
... |
| 399 |
(* Alternative, schnellere Routinen sind in MatLib zu finden *)
|
399 |
(* Alternative, schnellere Routinen sind in MatLib zu finden *)
|
| 400 |
(* (MatMatProd{NN|NT|TN,TT}) *)
|
400 |
(* (MatMatProd{NN|NT|TN,TT}) *)
|
| 401 |
(*----------------------------------------------------------------*)
|
401 |
(*----------------------------------------------------------------*)
|
| 402 |
|
402 |
|
| 403 |
PROCEDURE dger( m,n : CARDINAL;
|
403 |
PROCEDURE dger( m,n : CARDINAL;
|
| 404 |
Alpha : FLOAT;
|
404 |
Alpha : REAL8;
|
| 405 |
VAR X : ARRAY OF FLOAT;
|
405 |
VAR X : ARRAY OF REAL8;
|
| 406 |
IncX : CARDINAL;
|
406 |
IncX : CARDINAL;
|
| 407 |
VAR Y : ARRAY OF FLOAT;
|
407 |
VAR Y : ARRAY OF REAL8;
|
| 408 |
IncY : CARDINAL;
|
408 |
IncY : CARDINAL;
|
| 409 |
VAR A : ARRAY OF ARRAY OF FLOAT;
|
409 |
VAR A : ARRAY OF ARRAY OF REAL8;
|
| 410 |
lda : CARDINAL);
|
410 |
lda : CARDINAL);
|
| 411 |
|
411 |
|
| 412 |
(*--------------------------------------------------------------*)
|
412 |
(*--------------------------------------------------------------*)
|
| 413 |
(* DGER performs the rank 1 operation *)
|
413 |
(* DGER performs the rank 1 operation *)
|
| 414 |
(* *)
|
414 |
(* *)
|
|
... |
|
... |
| 447 |
(* is overwritten by the updated matrix. *)
|
447 |
(* is overwritten by the updated matrix. *)
|
| 448 |
(* *)
|
448 |
(* *)
|
| 449 |
(*--------------------------------------------------------------*)
|
449 |
(*--------------------------------------------------------------*)
|
| 450 |
|
450 |
|
| 451 |
PROCEDURE zswap( N : CARDINAL;
|
451 |
PROCEDURE zswap( N : CARDINAL;
|
| 452 |
VAR X : ARRAY OF CFLOAT;
|
452 |
VAR X : ARRAY OF COMPLEX16;
|
| 453 |
IncX : INTEGER;
|
453 |
IncX : INTEGER;
|
| 454 |
VAR Y : ARRAY OF CFLOAT;
|
454 |
VAR Y : ARRAY OF COMPLEX16;
|
| 455 |
IncY : INTEGER);
|
455 |
IncY : INTEGER);
|
| 456 |
|
456 |
|
| 457 |
(*----------------------------------------------------------------*)
|
457 |
(*----------------------------------------------------------------*)
|
| 458 |
(* Swap complex vectors X and Y *)
|
458 |
(* Swap complex vectors X and Y *)
|
| 459 |
(*----------------------------------------------------------------*)
|
459 |
(*----------------------------------------------------------------*)
|
| 460 |
|
460 |
|
| 461 |
PROCEDURE zcopy( N : INTEGER;
|
461 |
PROCEDURE zcopy( N : INTEGER;
|
| 462 |
VAR X : ARRAY OF CFLOAT;
|
462 |
VAR X : ARRAY OF COMPLEX16;
|
| 463 |
IncX : INTEGER;
|
463 |
IncX : INTEGER;
|
| 464 |
VAR Y : ARRAY OF CFLOAT;
|
464 |
VAR Y : ARRAY OF COMPLEX16;
|
| 465 |
IncY : INTEGER);
|
465 |
IncY : INTEGER);
|
| 466 |
|
466 |
|
| 467 |
(*----------------------------------------------------------------*)
|
467 |
(*----------------------------------------------------------------*)
|
| 468 |
(* copies a vector, x, to a vector, y. *)
|
468 |
(* copies a vector, x, to a vector, y. *)
|
| 469 |
(* uses unrolled loops for increments equal to one. *)
|
469 |
(* uses unrolled loops for increments equal to one. *)
|
| 470 |
(* jack dongarra, linpack, 3/11/78. *)
|
470 |
(* jack dongarra, linpack, 3/11/78. *)
|
| 471 |
(* MRi, Modula-2 10.04.16 | 09.09.18 (complex version) *)
|
471 |
(* MRi, Modula-2 10.04.16 | 09.09.18 (complex version) *)
|
| 472 |
(*----------------------------------------------------------------*)
|
472 |
(*----------------------------------------------------------------*)
|
| 473 |
|
473 |
|
| 474 |
PROCEDURE zdotc( N : INTEGER;
|
474 |
PROCEDURE zdotc( N : INTEGER;
|
| 475 |
VAR X : ARRAY OF CFLOAT;
|
475 |
VAR X : ARRAY OF COMPLEX16;
|
| 476 |
IncX : INTEGER;
|
476 |
IncX : INTEGER;
|
| 477 |
VAR Y : ARRAY OF CFLOAT;
|
477 |
VAR Y : ARRAY OF COMPLEX16;
|
| 478 |
IncY : INTEGER) : CFLOAT;
|
478 |
IncY : INTEGER) : COMPLEX16;
|
| 479 |
|
479 |
|
| 480 |
(*----------------------------------------------------------------*)
|
480 |
(*----------------------------------------------------------------*)
|
| 481 |
(* Forms the dot product of two vectors. Uses unrolled loops for *)
|
481 |
(* Forms the dot product of two vectors. Uses unrolled loops for *)
|
| 482 |
(* increments equal to one. *)
|
482 |
(* increments equal to one. *)
|
| 483 |
(*----------------------------------------------------------------*)
|
483 |
(*----------------------------------------------------------------*)
|
| 484 |
|
484 |
|
| 485 |
|
485 |
|
| 486 |
PROCEDURE dznrm2( N : INTEGER;
|
486 |
PROCEDURE dznrm2( N : INTEGER;
|
| 487 |
VAR X : ARRAY OF CFLOAT;
|
487 |
VAR X : ARRAY OF COMPLEX16;
|
| 488 |
IncX : INTEGER) : FLOAT;
|
488 |
IncX : INTEGER) : REAL8;
|
| 489 |
|
489 |
|
| 490 |
(*----------------------------------------------------------------*)
|
490 |
(*----------------------------------------------------------------*)
|
| 491 |
(* dznrm2 returns the euclidean norm of a vector so that *)
|
491 |
(* dznrm2 returns the euclidean norm of a vector so that *)
|
| 492 |
(* dznrm2 := sqrt( X**H*X ) *)
|
492 |
(* dznrm2 := sqrt( X**H*X ) *)
|
| 493 |
(*----------------------------------------------------------------*)
|
493 |
(*----------------------------------------------------------------*)
|
| 494 |
|
494 |
|
| 495 |
PROCEDURE zscal( n : INTEGER;
|
495 |
PROCEDURE zscal( n : INTEGER;
|
| 496 |
da : CFLOAT;
|
496 |
da : COMPLEX16;
|
| 497 |
VAR dx : ARRAY OF CFLOAT;
|
497 |
VAR dx : ARRAY OF COMPLEX16;
|
| 498 |
IncX : INTEGER);
|
498 |
IncX : INTEGER);
|
| 499 |
|
499 |
|
| 500 |
(*----------------------------------------------------------------*)
|
500 |
(*----------------------------------------------------------------*)
|
| 501 |
(* Scales a vector by a constant (UNROLLED version) *)
|
501 |
(* Scales a vector by a constant (UNROLLED version) *)
|
| 502 |
(*----------------------------------------------------------------*)
|
502 |
(*----------------------------------------------------------------*)
|
| 503 |
|
503 |
|
| 504 |
PROCEDURE zaxpy( n : INTEGER;
|
504 |
PROCEDURE zaxpy( n : INTEGER;
|
| 505 |
da : CFLOAT;
|
505 |
da : COMPLEX16;
|
| 506 |
VAR X : ARRAY OF CFLOAT;
|
506 |
VAR X : ARRAY OF COMPLEX16;
|
| 507 |
IncX : INTEGER;
|
507 |
IncX : INTEGER;
|
| 508 |
VAR Y : ARRAY OF CFLOAT;
|
508 |
VAR Y : ARRAY OF COMPLEX16;
|
| 509 |
IncY : INTEGER);
|
509 |
IncY : INTEGER);
|
| 510 |
|
510 |
|
| 511 |
(*----------------------------------------------------------------*)
|
511 |
(*----------------------------------------------------------------*)
|
| 512 |
(* constant times a vector plus a vector *)
|
512 |
(* constant times a vector plus a vector *)
|
| 513 |
(*----------------------------------------------------------------*)
|
513 |
(*----------------------------------------------------------------*)
|
| 514 |
|
514 |
|
| 515 |
PROCEDURE zdrot( N : INTEGER;
|
515 |
PROCEDURE zdrot( N : INTEGER;
|
| 516 |
VAR X : ARRAY OF CFLOAT;
|
516 |
VAR X : ARRAY OF COMPLEX16;
|
| 517 |
IncX : INTEGER;
|
517 |
IncX : INTEGER;
|
| 518 |
VAR Y : ARRAY OF CFLOAT;
|
518 |
VAR Y : ARRAY OF COMPLEX16;
|
| 519 |
IncY : INTEGER;
|
519 |
IncY : INTEGER;
|
| 520 |
c,s : FLOAT);
|
520 |
c,s : REAL8);
|
| 521 |
|
521 |
|
| 522 |
(*----------------------------------------------------------------*)
|
522 |
(*----------------------------------------------------------------*)
|
| 523 |
(* Applies a plane rotation, where the cos and sin (c and s) are *)
|
523 |
(* Applies a plane rotation, where the cos and sin (c and s) are *)
|
| 524 |
(* real and the vectors cx and cy are complex. *)
|
524 |
(* real and the vectors cx and cy are complex. *)
|
| 525 |
(*----------------------------------------------------------------*)
|
525 |
(*----------------------------------------------------------------*)
|
| 526 |
|
526 |
|
| 527 |
PROCEDURE zgemv( Trans : CHAR;
|
527 |
PROCEDURE zgemv( Trans : CHAR;
|
| 528 |
M,N : INTEGER;
|
528 |
M,N : INTEGER;
|
| 529 |
Alpha : CFLOAT;
|
529 |
Alpha : COMPLEX16;
|
| 530 |
VAR A : ARRAY OF ARRAY OF CFLOAT;
|
530 |
VAR A : ARRAY OF ARRAY OF COMPLEX16;
|
| 531 |
lda : INTEGER;
|
531 |
lda : INTEGER;
|
| 532 |
VAR X : ARRAY OF CFLOAT;
|
532 |
VAR X : ARRAY OF COMPLEX16;
|
| 533 |
IncX : INTEGER;
|
533 |
IncX : INTEGER;
|
| 534 |
Beta : CFLOAT;
|
534 |
Beta : COMPLEX16;
|
| 535 |
VAR Y : ARRAY OF CFLOAT;
|
535 |
VAR Y : ARRAY OF COMPLEX16;
|
| 536 |
IncY : INTEGER);
|
536 |
IncY : INTEGER);
|
| 537 |
|
537 |
|
| 538 |
(*----------------------------------------------------------------*)
|
538 |
(*----------------------------------------------------------------*)
|
| 539 |
(* Performs one of the matrix-vector operations *)
|
539 |
(* Performs one of the matrix-vector operations *)
|
| 540 |
(* *)
|
540 |
(* *)
|
|
... |
|
... |
| 595 |
(* Richard Hanson, Sandia National Labs. *)
|
595 |
(* Richard Hanson, Sandia National Labs. *)
|
| 596 |
(*----------------------------------------------------------------*)
|
596 |
(*----------------------------------------------------------------*)
|
| 597 |
|
597 |
|
| 598 |
PROCEDURE zgemm( TransA,TransB : CHAR;
|
598 |
PROCEDURE zgemm( TransA,TransB : CHAR;
|
| 599 |
M,N,K : INTEGER;
|
599 |
M,N,K : INTEGER;
|
| 600 |
Alpha : CFLOAT;
|
600 |
Alpha : COMPLEX16;
|
| 601 |
VAR A : ARRAY OF ARRAY OF CFLOAT;
|
601 |
VAR A : ARRAY OF ARRAY OF COMPLEX16;
|
| 602 |
LDA : INTEGER;
|
602 |
LDA : INTEGER;
|
| 603 |
VAR B : ARRAY OF ARRAY OF CFLOAT;
|
603 |
VAR B : ARRAY OF ARRAY OF COMPLEX16;
|
| 604 |
LDB : INTEGER;
|
604 |
LDB : INTEGER;
|
| 605 |
Beta : CFLOAT;
|
605 |
Beta : COMPLEX16;
|
| 606 |
VAR C : ARRAY OF ARRAY OF CFLOAT;
|
606 |
VAR C : ARRAY OF ARRAY OF COMPLEX16;
|
| 607 |
LDC : INTEGER);
|
607 |
LDC : INTEGER);
|
| 608 |
|
608 |
|
| 609 |
(*----------------------------------------------------------------*)
|
609 |
(*----------------------------------------------------------------*)
|
| 610 |
(* Purpose *)
|
610 |
(* Purpose *)
|
| 611 |
(* ======= *)
|
611 |
(* ======= *)
|