Skip to content

Commit 510c722

Browse files
martin-frbgmartin-frbg
committed
Add dummy C files for 3.10.1 modules
1 parent ee7f422 commit 510c722

File tree

2 files changed

+762
-0
lines changed

2 files changed

+762
-0
lines changed

‎lapack-netlib/SRC/la_constants.c

Lines changed: 381 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,381 @@
1+
/* f2c.h -- Standard Fortran to C header file */
2+
3+
/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed."
4+
5+
- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
6+
7+
#ifndef F2C_INCLUDE
8+
#define F2C_INCLUDE
9+
10+
#include <math.h>
11+
#include <stdlib.h>
12+
#include <string.h>
13+
#include <stdio.h>
14+
#include <complex.h>
15+
#ifdef complex
16+
#undef complex
17+
#endif
18+
#ifdef I
19+
#undef I
20+
#endif
21+
22+
typedef int integer;
23+
typedef unsigned int uinteger;
24+
typedef char *address;
25+
typedef short int shortint;
26+
typedef float real;
27+
typedef double doublereal;
28+
typedef struct { real r, i; } complex;
29+
typedef struct { doublereal r, i; } doublecomplex;
30+
static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;}
31+
static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;}
32+
static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;}
33+
static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;}
34+
#define pCf(z) (*_pCf(z))
35+
#define pCd(z) (*_pCd(z))
36+
typedef int logical;
37+
typedef short int shortlogical;
38+
typedef char logical1;
39+
typedef char integer1;
40+
41+
#define TRUE_ (1)
42+
#define FALSE_ (0)
43+
44+
/* Extern is for use with -E */
45+
#ifndef Extern
46+
#define Extern extern
47+
#endif
48+
49+
/* I/O stuff */
50+
51+
typedef int flag;
52+
typedef int ftnlen;
53+
typedef int ftnint;
54+
55+
/*external read, write*/
56+
typedef struct
57+
{ flag cierr;
58+
ftnint ciunit;
59+
flag ciend;
60+
char *cifmt;
61+
ftnint cirec;
62+
} cilist;
63+
64+
/*internal read, write*/
65+
typedef struct
66+
{ flag icierr;
67+
char *iciunit;
68+
flag iciend;
69+
char *icifmt;
70+
ftnint icirlen;
71+
ftnint icirnum;
72+
} icilist;
73+
74+
/*open*/
75+
typedef struct
76+
{ flag oerr;
77+
ftnint ounit;
78+
char *ofnm;
79+
ftnlen ofnmlen;
80+
char *osta;
81+
char *oacc;
82+
char *ofm;
83+
ftnint orl;
84+
char *oblnk;
85+
} olist;
86+
87+
/*close*/
88+
typedef struct
89+
{ flag cerr;
90+
ftnint cunit;
91+
char *csta;
92+
} cllist;
93+
94+
/*rewind, backspace, endfile*/
95+
typedef struct
96+
{ flag aerr;
97+
ftnint aunit;
98+
} alist;
99+
100+
/* inquire */
101+
typedef struct
102+
{ flag inerr;
103+
ftnint inunit;
104+
char *infile;
105+
ftnlen infilen;
106+
ftnint *inex; /*parameters in standard's order*/
107+
ftnint *inopen;
108+
ftnint *innum;
109+
ftnint *innamed;
110+
char *inname;
111+
ftnlen innamlen;
112+
char *inacc;
113+
ftnlen inacclen;
114+
char *inseq;
115+
ftnlen inseqlen;
116+
char *indir;
117+
ftnlen indirlen;
118+
char *infmt;
119+
ftnlen infmtlen;
120+
char *inform;
121+
ftnint informlen;
122+
char *inunf;
123+
ftnlen inunflen;
124+
ftnint *inrecl;
125+
ftnint *innrec;
126+
char *inblank;
127+
ftnlen inblanklen;
128+
} inlist;
129+
130+
#define VOID void
131+
132+
union Multitype { /* for multiple entry points */
133+
integer1 g;
134+
shortint h;
135+
integer i;
136+
/* longint j; */
137+
real r;
138+
doublereal d;
139+
complex c;
140+
doublecomplex z;
141+
};
142+
143+
typedef union Multitype Multitype;
144+
145+
struct Vardesc { /* for Namelist */
146+
char *name;
147+
char *addr;
148+
ftnlen *dims;
149+
int type;
150+
};
151+
typedef struct Vardesc Vardesc;
152+
153+
struct Namelist {
154+
char *name;
155+
Vardesc **vars;
156+
int nvars;
157+
};
158+
typedef struct Namelist Namelist;
159+
160+
#define abs(x) ((x) >= 0 ? (x) : -(x))
161+
#define dabs(x) (fabs(x))
162+
#define f2cmin(a,b) ((a) <= (b) ? (a) : (b))
163+
#define f2cmax(a,b) ((a) >= (b) ? (a) : (b))
164+
#define dmin(a,b) (f2cmin(a,b))
165+
#define dmax(a,b) (f2cmax(a,b))
166+
#define bit_test(a,b) ((a) >> (b) & 1)
167+
#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
168+
#define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
169+
170+
#define abort_() { sig_die("Fortran abort routine called", 1); }
171+
#define c_abs(z) (cabsf(Cf(z)))
172+
#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); }
173+
#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);}
174+
#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);}
175+
#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));}
176+
#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));}
177+
#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));}
178+
//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));}
179+
#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));}
180+
#define d_abs(x) (fabs(*(x)))
181+
#define d_acos(x) (acos(*(x)))
182+
#define d_asin(x) (asin(*(x)))
183+
#define d_atan(x) (atan(*(x)))
184+
#define d_atn2(x, y) (atan2(*(x),*(y)))
185+
#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); }
186+
#define r_cnjg(R, Z) { pCf(R) = conj(Cf(Z)); }
187+
#define d_cos(x) (cos(*(x)))
188+
#define d_cosh(x) (cosh(*(x)))
189+
#define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 )
190+
#define d_exp(x) (exp(*(x)))
191+
#define d_imag(z) (cimag(Cd(z)))
192+
#define r_imag(z) (cimag(Cf(z)))
193+
#define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x)))
194+
#define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x)))
195+
#define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) )
196+
#define r_lg10(x) ( 0.43429448190325182765 * log(*(x)) )
197+
#define d_log(x) (log(*(x)))
198+
#define d_mod(x, y) (fmod(*(x), *(y)))
199+
#define u_nint(__x) ((__x)>=0 ? floor((__x) + .5) : -floor(.5 - (__x)))
200+
#define d_nint(x) u_nint(*(x))
201+
#define u_sign(__a,__b) ((__b) >= 0 ? ((__a) >= 0 ? (__a) : -(__a)) : -((__a) >= 0 ? (__a) : -(__a)))
202+
#define d_sign(a,b) u_sign(*(a),*(b))
203+
#define r_sign(a,b) u_sign(*(a),*(b))
204+
#define d_sin(x) (sin(*(x)))
205+
#define d_sinh(x) (sinh(*(x)))
206+
#define d_sqrt(x) (sqrt(*(x)))
207+
#define d_tan(x) (tan(*(x)))
208+
#define d_tanh(x) (tanh(*(x)))
209+
#define i_abs(x) abs(*(x))
210+
#define i_dnnt(x) ((integer)u_nint(*(x)))
211+
#define i_len(s, n) (n)
212+
#define i_nint(x) ((integer)u_nint(*(x)))
213+
#define i_sign(a,b) ((integer)u_sign((integer)*(a),(integer)*(b)))
214+
#define pow_dd(ap, bp) ( pow(*(ap), *(bp)))
215+
#define pow_si(B,E) spow_ui(*(B),*(E))
216+
#define pow_ri(B,E) spow_ui(*(B),*(E))
217+
#define pow_di(B,E) dpow_ui(*(B),*(E))
218+
#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));}
219+
#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));}
220+
#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));}
221+
#define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; }
222+
#define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d))))
223+
#define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; }
224+
#define sig_die(s, kill) { exit(1); }
225+
#define s_stop(s, n) {exit(0);}
226+
static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
227+
#define z_abs(z) (cabs(Cd(z)))
228+
#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));}
229+
#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));}
230+
#define myexit_() break;
231+
#define mycycle_() continue;
232+
#define myceiling_(w) ceil(w)
233+
#define myhuge_(w) HUGE_VAL
234+
//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
235+
#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n)
236+
237+
/* procedure parameter types for -A and -C++ */
238+
239+
#define F2C_proc_par_types 1
240+
#ifdef __cplusplus
241+
typedef logical (*L_fp)(...);
242+
#else
243+
typedef logical (*L_fp)();
244+
#endif
245+
246+
static float spow_ui(float x, integer n) {
247+
float pow=1.0; unsigned long int u;
248+
if(n != 0) {
249+
if(n < 0) n = -n, x = 1/x;
250+
for(u = n; ; ) {
251+
if(u & 01) pow *= x;
252+
if(u >>= 1) x *= x;
253+
else break;
254+
}
255+
}
256+
return pow;
257+
}
258+
static double dpow_ui(double x, integer n) {
259+
double pow=1.0; unsigned long int u;
260+
if(n != 0) {
261+
if(n < 0) n = -n, x = 1/x;
262+
for(u = n; ; ) {
263+
if(u & 01) pow *= x;
264+
if(u >>= 1) x *= x;
265+
else break;
266+
}
267+
}
268+
return pow;
269+
}
270+
static _Complex float cpow_ui(_Complex float x, integer n) {
271+
_Complex float pow=1.0; unsigned long int u;
272+
if(n != 0) {
273+
if(n < 0) n = -n, x = 1/x;
274+
for(u = n; ; ) {
275+
if(u & 01) pow *= x;
276+
if(u >>= 1) x *= x;
277+
else break;
278+
}
279+
}
280+
return pow;
281+
}
282+
static _Complex double zpow_ui(_Complex double x, integer n) {
283+
_Complex double pow=1.0; unsigned long int u;
284+
if(n != 0) {
285+
if(n < 0) n = -n, x = 1/x;
286+
for(u = n; ; ) {
287+
if(u & 01) pow *= x;
288+
if(u >>= 1) x *= x;
289+
else break;
290+
}
291+
}
292+
return pow;
293+
}
294+
static integer pow_ii(integer x, integer n) {
295+
integer pow; unsigned long int u;
296+
if (n <= 0) {
297+
if (n == 0 || x == 1) pow = 1;
298+
else if (x != -1) pow = x == 0 ? 1/x : 0;
299+
else n = -n;
300+
}
301+
if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
302+
u = n;
303+
for(pow = 1; ; ) {
304+
if(u & 01) pow *= x;
305+
if(u >>= 1) x *= x;
306+
else break;
307+
}
308+
}
309+
return pow;
310+
}
311+
static integer dmaxloc_(double *w, integer s, integer e, integer *n)
312+
{
313+
double m; integer i, mi;
314+
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
315+
if (w[i-1]>m) mi=i ,m=w[i-1];
316+
return mi-s+1;
317+
}
318+
static integer smaxloc_(float *w, integer s, integer e, integer *n)
319+
{
320+
float m; integer i, mi;
321+
for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
322+
if (w[i-1]>m) mi=i ,m=w[i-1];
323+
return mi-s+1;
324+
}
325+
static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
326+
integer n = *n_, incx = *incx_, incy = *incy_, i;
327+
_Complex float zdotc = 0.0;
328+
if (incx == 1 && incy == 1) {
329+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
330+
zdotc += conjf(Cf(&x[i])) * Cf(&y[i]);
331+
}
332+
} else {
333+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
334+
zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]);
335+
}
336+
}
337+
pCf(z) = zdotc;
338+
}
339+
static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
340+
integer n = *n_, incx = *incx_, incy = *incy_, i;
341+
_Complex double zdotc = 0.0;
342+
if (incx == 1 && incy == 1) {
343+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
344+
zdotc += conj(Cd(&x[i])) * Cd(&y[i]);
345+
}
346+
} else {
347+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
348+
zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]);
349+
}
350+
}
351+
pCd(z) = zdotc;
352+
}
353+
static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
354+
integer n = *n_, incx = *incx_, incy = *incy_, i;
355+
_Complex float zdotc = 0.0;
356+
if (incx == 1 && incy == 1) {
357+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
358+
zdotc += Cf(&x[i]) * Cf(&y[i]);
359+
}
360+
} else {
361+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
362+
zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]);
363+
}
364+
}
365+
pCf(z) = zdotc;
366+
}
367+
static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
368+
integer n = *n_, incx = *incx_, incy = *incy_, i;
369+
_Complex double zdotc = 0.0;
370+
if (incx == 1 && incy == 1) {
371+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
372+
zdotc += Cd(&x[i]) * Cd(&y[i]);
373+
}
374+
} else {
375+
for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
376+
zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]);
377+
}
378+
}
379+
pCd(z) = zdotc;
380+
}
381+
#endif

0 commit comments

Comments
 (0)