History

Commit netlib.org version of dgemm.c and lsame.c into source tree. Update readme.md with the netlib.org LAPACK license (modified BSD license).

arr committed 9 years ago

Commit e3e44c81 parent 360d51c3 files · +556 −0Browse files

Unified · Split

3 files
  1. readme.md +51 −0
  2. src/vm/math/dgemm.c +395 −0
  3. src/vm/math/lsame.c +110 −0
readme.md+51−0
@@ -116,6 +116,57 @@ The above copyright notice and this permission notice shall be included in all c · 115 unmodified lines
116116
117117 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
118118
119+### [LAPACK](http://www.netlib.org/lapack/#_licensing) ###
120+
121+Copyright (c) 1992-2013 The University of Tennessee and The University
122+ of Tennessee Research Foundation. All rights
123+ reserved.
124+Copyright (c) 2000-2013 The University of California Berkeley. All
125+ rights reserved.
126+Copyright (c) 2006-2013 The University of Colorado Denver. All rights
127+ reserved.
128+
129+$COPYRIGHT$
130+
131+Additional copyrights may follow
132+
133+$HEADER$
134+
135+Redistribution and use in source and binary forms, with or without
136+modification, are permitted provided that the following conditions are
137+met:
138+
139+- Redistributions of source code must retain the above copyright
140+ notice, this list of conditions and the following disclaimer.
141+
142+- Redistributions in binary form must reproduce the above copyright
143+ notice, this list of conditions and the following disclaimer listed
144+ in this license in the documentation and/or other materials
145+ provided with the distribution.
146+
147+- Neither the name of the copyright holders nor the names of its
148+ contributors may be used to endorse or promote products derived from
149+ this software without specific prior written permission.
150+
151+The copyright holders provide no reassurances that the source code
152+provided does not infringe any patent, copyright, or any other
153+intellectual property rights of third parties. The copyright holders
154+disclaim any liability to any recipient for claims brought against
155+recipient by any third party for infringement of that parties
156+intellectual property rights.
157+
158+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
159+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
160+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
161+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
162+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
163+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
164+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
165+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
166+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
167+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
168+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
169+
119170 ### Unless otherwise stated in a `license.txt` or above - [MIT License](https://opensource.org/licenses/MIT) ###
120171
121172 Copyright (c) 2017 arr
src/vm/math/dgemm.c+395−0
@@ -0,0 +1,395 @@
1+
2+/* -- translated by f2c (version 19940927).
3+ You must link the resulting object file with the libraries:
4+ -lf2c -lm (in that order)
5+*/
6+
7+#include "f2c.h"
8+
9+/* Subroutine */ int dgemm_(char *transa, char *transb, integer *m, integer *
10+ n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
11+ doublereal *b, integer *ldb, doublereal *beta, doublereal *c, integer
12+ *ldc)
13+{
14+
15+
16+ /* System generated locals */
17+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
18+ i__3;
19+
20+ /* Local variables */
21+ static integer info;
22+ static logical nota, notb;
23+ static doublereal temp;
24+ static integer i, j, l, ncola;
25+ extern logical lsame_(char *, char *);
26+ static integer nrowa, nrowb;
27+ extern /* Subroutine */ int xerbla_(char *, integer *);
28+
29+
30+/* Purpose
31+ =======
32+
33+ DGEMM performs one of the matrix-matrix operations
34+
35+ C := alpha*op( A )*op( B ) + beta*C,
36+
37+ where op( X ) is one of
38+
39+ op( X ) = X or op( X ) = X',
40+
41+ alpha and beta are scalars, and A, B and C are matrices, with op( A )
42+
43+ an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
44+
45+
46+ Parameters
47+ ==========
48+
49+ TRANSA - CHARACTER*1.
50+ On entry, TRANSA specifies the form of op( A ) to be used in
51+
52+ the matrix multiplication as follows:
53+
54+ TRANSA = 'N' or 'n', op( A ) = A.
55+
56+ TRANSA = 'T' or 't', op( A ) = A'.
57+
58+ TRANSA = 'C' or 'c', op( A ) = A'.
59+
60+ Unchanged on exit.
61+
62+ TRANSB - CHARACTER*1.
63+ On entry, TRANSB specifies the form of op( B ) to be used in
64+
65+ the matrix multiplication as follows:
66+
67+ TRANSB = 'N' or 'n', op( B ) = B.
68+
69+ TRANSB = 'T' or 't', op( B ) = B'.
70+
71+ TRANSB = 'C' or 'c', op( B ) = B'.
72+
73+ Unchanged on exit.
74+
75+ M - INTEGER.
76+ On entry, M specifies the number of rows of the matrix
77+
78+ op( A ) and of the matrix C. M must be at least zero.
79+
80+ Unchanged on exit.
81+
82+ N - INTEGER.
83+ On entry, N specifies the number of columns of the matrix
84+
85+ op( B ) and the number of columns of the matrix C. N must be
86+
87+ at least zero.
88+ Unchanged on exit.
89+
90+ K - INTEGER.
91+ On entry, K specifies the number of columns of the matrix
92+
93+ op( A ) and the number of rows of the matrix op( B ). K must
94+
95+ be at least zero.
96+ Unchanged on exit.
97+
98+ ALPHA - DOUBLE PRECISION.
99+ On entry, ALPHA specifies the scalar alpha.
100+ Unchanged on exit.
101+
102+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
103+
104+ k when TRANSA = 'N' or 'n', and is m otherwise.
105+ Before entry with TRANSA = 'N' or 'n', the leading m by k
106+
107+ part of the array A must contain the matrix A, otherwise
108+
109+ the leading k by m part of the array A must contain the
110+
111+ matrix A.
112+ Unchanged on exit.
113+
114+ LDA - INTEGER.
115+ On entry, LDA specifies the first dimension of A as declared
116+
117+ in the calling (sub) program. When TRANSA = 'N' or 'n' then
118+
119+ LDA must be at least max( 1, m ), otherwise LDA must be at
120+
121+ least max( 1, k ).
122+ Unchanged on exit.
123+
124+ B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
125+
126+ n when TRANSB = 'N' or 'n', and is k otherwise.
127+ Before entry with TRANSB = 'N' or 'n', the leading k by n
128+
129+ part of the array B must contain the matrix B, otherwise
130+
131+ the leading n by k part of the array B must contain the
132+
133+ matrix B.
134+ Unchanged on exit.
135+
136+ LDB - INTEGER.
137+ On entry, LDB specifies the first dimension of B as declared
138+
139+ in the calling (sub) program. When TRANSB = 'N' or 'n' then
140+
141+ LDB must be at least max( 1, k ), otherwise LDB must be at
142+
143+ least max( 1, n ).
144+ Unchanged on exit.
145+
146+ BETA - DOUBLE PRECISION.
147+ On entry, BETA specifies the scalar beta. When BETA is
148+
149+ supplied as zero then C need not be set on input.
150+ Unchanged on exit.
151+
152+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
153+ Before entry, the leading m by n part of the array C must
154+
155+ contain the matrix C, except when beta is zero, in which
156+
157+ case C need not be set on entry.
158+ On exit, the array C is overwritten by the m by n matrix
159+
160+ ( alpha*op( A )*op( B ) + beta*C ).
161+
162+ LDC - INTEGER.
163+ On entry, LDC specifies the first dimension of C as declared
164+
165+ in the calling (sub) program. LDC must be at least
166+
167+ max( 1, m ).
168+ Unchanged on exit.
169+
170+
171+ Level 3 Blas routine.
172+
173+ -- Written on 8-February-1989.
174+ Jack Dongarra, Argonne National Laboratory.
175+ Iain Duff, AERE Harwell.
176+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
177+ Sven Hammarling, Numerical Algorithms Group Ltd.
178+
179+
180+
181+ Set NOTA and NOTB as true if A and B respectively are not
182+
183+ transposed and set NROWA, NCOLA and NROWB as the number of rows
184+
185+ and columns of A and the number of rows of B respectively.
186+
187+
188+
189+ Parameter adjustments
190+ Function Body */
191+
192+#define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
193+#define B(I,J) b[(I)-1 + ((J)-1)* ( *ldb)]
194+#define C(I,J) c[(I)-1 + ((J)-1)* ( *ldc)]
195+
196+ nota = lsame_(transa, "N");
197+ notb = lsame_(transb, "N");
198+ if (nota) {
199+ nrowa = *m;
200+ ncola = *k;
201+ } else {
202+ nrowa = *k;
203+ ncola = *m;
204+ }
205+ if (notb) {
206+ nrowb = *k;
207+ } else {
208+ nrowb = *n;
209+ }
210+
211+/* Test the input parameters. */
212+
213+ info = 0;
214+ if (! nota && ! lsame_(transa, "C") && ! lsame_(transa, "T")) {
215+ info = 1;
216+ } else if (! notb && ! lsame_(transb, "C") && ! lsame_(transb,
217+ "T")) {
218+ info = 2;
219+ } else if (*m < 0) {
220+ info = 3;
221+ } else if (*n < 0) {
222+ info = 4;
223+ } else if (*k < 0) {
224+ info = 5;
225+ } else if (*lda < max(1,nrowa)) {
226+ info = 8;
227+ } else if (*ldb < max(1,nrowb)) {
228+ info = 10;
229+ } else if (*ldc < max(1,*m)) {
230+ info = 13;
231+ }
232+ if (info != 0) {
233+ xerbla_("DGEMM ", &info);
234+ return 0;
235+ }
236+
237+/* Quick return if possible. */
238+
239+ if (*m == 0 || *n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {
240+ return 0;
241+ }
242+
243+/* And if alpha.eq.zero. */
244+
245+ if (*alpha == 0.) {
246+ if (*beta == 0.) {
247+ i__1 = *n;
248+ for (j = 1; j <= *n; ++j) {
249+ i__2 = *m;
250+ for (i = 1; i <= *m; ++i) {
251+ C(i,j) = 0.;
252+/* L10: */
253+ }
254+/* L20: */
255+ }
256+ } else {
257+ i__1 = *n;
258+ for (j = 1; j <= *n; ++j) {
259+ i__2 = *m;
260+ for (i = 1; i <= *m; ++i) {
261+ C(i,j) = *beta * C(i,j);
262+/* L30: */
263+ }
264+/* L40: */
265+ }
266+ }
267+ return 0;
268+ }
269+
270+/* Start the operations. */
271+
272+ if (notb) {
273+ if (nota) {
274+
275+/* Form C := alpha*A*B + beta*C. */
276+
277+ i__1 = *n;
278+ for (j = 1; j <= *n; ++j) {
279+ if (*beta == 0.) {
280+ i__2 = *m;
281+ for (i = 1; i <= *m; ++i) {
282+ C(i,j) = 0.;
283+/* L50: */
284+ }
285+ } else if (*beta != 1.) {
286+ i__2 = *m;
287+ for (i = 1; i <= *m; ++i) {
288+ C(i,j) = *beta * C(i,j);
289+/* L60: */
290+ }
291+ }
292+ i__2 = *k;
293+ for (l = 1; l <= *k; ++l) {
294+ if (B(l,j) != 0.) {
295+ temp = *alpha * B(l,j);
296+ i__3 = *m;
297+ for (i = 1; i <= *m; ++i) {
298+ C(i,j) += temp * A(i,l);
299+/* L70: */
300+ }
301+ }
302+/* L80: */
303+ }
304+/* L90: */
305+ }
306+ } else {
307+
308+/* Form C := alpha*A'*B + beta*C */
309+
310+ i__1 = *n;
311+ for (j = 1; j <= *n; ++j) {
312+ i__2 = *m;
313+ for (i = 1; i <= *m; ++i) {
314+ temp = 0.;
315+ i__3 = *k;
316+ for (l = 1; l <= *k; ++l) {
317+ temp += A(l,i) * B(l,j);
318+/* L100: */
319+ }
320+ if (*beta == 0.) {
321+ C(i,j) = *alpha * temp;
322+ } else {
323+ C(i,j) = *alpha * temp + *beta * C(i,j);
324+ }
325+/* L110: */
326+ }
327+/* L120: */
328+ }
329+ }
330+ } else {
331+ if (nota) {
332+
333+/* Form C := alpha*A*B' + beta*C */
334+
335+ i__1 = *n;
336+ for (j = 1; j <= *n; ++j) {
337+ if (*beta == 0.) {
338+ i__2 = *m;
339+ for (i = 1; i <= *m; ++i) {
340+ C(i,j) = 0.;
341+/* L130: */
342+ }
343+ } else if (*beta != 1.) {
344+ i__2 = *m;
345+ for (i = 1; i <= *m; ++i) {
346+ C(i,j) = *beta * C(i,j);
347+/* L140: */
348+ }
349+ }
350+ i__2 = *k;
351+ for (l = 1; l <= *k; ++l) {
352+ if (B(j,l) != 0.) {
353+ temp = *alpha * B(j,l);
354+ i__3 = *m;
355+ for (i = 1; i <= *m; ++i) {
356+ C(i,j) += temp * A(i,l);
357+/* L150: */
358+ }
359+ }
360+/* L160: */
361+ }
362+/* L170: */
363+ }
364+ } else {
365+
366+/* Form C := alpha*A'*B' + beta*C */
367+
368+ i__1 = *n;
369+ for (j = 1; j <= *n; ++j) {
370+ i__2 = *m;
371+ for (i = 1; i <= *m; ++i) {
372+ temp = 0.;
373+ i__3 = *k;
374+ for (l = 1; l <= *k; ++l) {
375+ temp += A(l,i) * B(j,l);
376+/* L180: */
377+ }
378+ if (*beta == 0.) {
379+ C(i,j) = *alpha * temp;
380+ } else {
381+ C(i,j) = *alpha * temp + *beta * C(i,j);
382+ }
383+/* L190: */
384+ }
385+/* L200: */
386+ }
387+ }
388+ }
389+
390+ return 0;
391+
392+/* End of DGEMM . */
393+
394+} /* dgemm_ */
395+
src/vm/math/lsame.c+110−0
@@ -0,0 +1,110 @@
1+/* -- translated by f2c (version 19940927).
2+ You must link the resulting object file with the libraries:
3+ -lf2c -lm (in that order)
4+*/
5+
6+#include "f2c.h"
7+
8+logical lsame_(char *ca, char *cb)
9+{
10+
11+
12+ /* System generated locals */
13+ logical ret_val;
14+
15+ /* Local variables */
16+ static integer inta, intb, zcode;
17+
18+
19+/* -- LAPACK auxiliary routine (version 2.0) --
20+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
21+ Courant Institute, Argonne National Lab, and Rice University
22+ January 31, 1994
23+
24+
25+ Purpose
26+ =======
27+
28+ LSAME returns .TRUE. if CA is the same letter as CB regardless of
29+ case.
30+
31+ Arguments
32+ =========
33+
34+ CA (input) CHARACTER*1
35+ CB (input) CHARACTER*1
36+ CA and CB specify the single characters to be compared.
37+
38+ =====================================================================
39+
40+
41+
42+ Test if the characters are equal */
43+
44+ ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
45+ if (ret_val) {
46+ return ret_val;
47+ }
48+
49+/* Now test for equivalence if both characters are alphabetic. */
50+
51+ zcode = 'Z';
52+
53+/* Use 'Z' rather than 'A' so that ASCII can be detected on Prime
54+ machines, on which ICHAR returns a value with bit 8 set.
55+ ICHAR('A') on Prime machines returns 193 which is the same as
56+ ICHAR('A') on an EBCDIC machine. */
57+
58+ inta = *(unsigned char *)ca;
59+ intb = *(unsigned char *)cb;
60+
61+ if (zcode == 90 || zcode == 122) {
62+
63+/* ASCII is assumed - ZCODE is the ASCII code of either lower o
64+r
65+ upper case 'Z'. */
66+
67+ if (inta >= 97 && inta <= 122) {
68+ inta += -32;
69+ }
70+ if (intb >= 97 && intb <= 122) {
71+ intb += -32;
72+ }
73+
74+ } else if (zcode == 233 || zcode == 169) {
75+
76+/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower
77+ or
78+ upper case 'Z'. */
79+
80+ if (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta
81+ >= 162 && inta <= 169) {
82+ inta += 64;
83+ }
84+ if (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb
85+ >= 162 && intb <= 169) {
86+ intb += 64;
87+ }
88+
89+ } else if (zcode == 218 || zcode == 250) {
90+
91+/* ASCII is assumed, on Prime machines - ZCODE is the ASCII cod
92+e
93+ plus 128 of either lower or upper case 'Z'. */
94+
95+ if (inta >= 225 && inta <= 250) {
96+ inta += -32;
97+ }
98+ if (intb >= 225 && intb <= 250) {
99+ intb += -32;
100+ }
101+ }
102+ ret_val = inta == intb;
103+
104+/* RETURN
105+
106+ End of LSAME */
107+
108+ return ret_val;
109+} /* lsame_ */
110+

Keyboard shortcuts

General

Show keyboard shortcuts
?
Focus the current search
/

Issues and pull requests

Open filters
f

Issues, pull requests and Inbox

Select next item
j↓
Select previous item
k↑
Open selected item
Enter
Dismiss filters or clear selection
Esc

Repository code

Go to file
t