Mercurial > hg > qm-dsp
comparison ext/clapack/src/s_cat.c @ 430:335af74a25b6
Merge from branch clapack-included
author | Chris Cannam <c.cannam@qmul.ac.uk> |
---|---|
date | Fri, 30 Sep 2016 16:24:24 +0100 |
parents | 905e45637745 |
children |
comparison
equal
deleted
inserted
replaced
426:a23b9f8b4a59 | 430:335af74a25b6 |
---|---|
1 /* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the | |
2 * target of a concatenation to appear on its right-hand side (contrary | |
3 * to the Fortran 77 Standard, but in accordance with Fortran 90). | |
4 */ | |
5 | |
6 #include "f2c.h" | |
7 #ifndef NO_OVERWRITE | |
8 #include "stdio.h" | |
9 #undef abs | |
10 #ifdef KR_headers | |
11 extern char *F77_aloc(); | |
12 extern void free(); | |
13 extern void exit_(); | |
14 #else | |
15 #undef min | |
16 #undef max | |
17 #include "stdlib.h" | |
18 extern | |
19 #ifdef __cplusplus | |
20 "C" | |
21 #endif | |
22 char *F77_aloc(ftnlen, const char*); | |
23 #endif | |
24 #include "string.h" | |
25 #endif /* NO_OVERWRITE */ | |
26 | |
27 #ifdef __cplusplus | |
28 extern "C" { | |
29 #endif | |
30 | |
31 VOID | |
32 #ifdef KR_headers | |
33 s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll; | |
34 #else | |
35 s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll) | |
36 #endif | |
37 { | |
38 ftnlen i, nc; | |
39 char *rp; | |
40 ftnlen n = *np; | |
41 #ifndef NO_OVERWRITE | |
42 ftnlen L, m; | |
43 char *lp0, *lp1; | |
44 | |
45 lp0 = 0; | |
46 lp1 = lp; | |
47 L = ll; | |
48 i = 0; | |
49 while(i < n) { | |
50 rp = rpp[i]; | |
51 m = rnp[i++]; | |
52 if (rp >= lp1 || rp + m <= lp) { | |
53 if ((L -= m) <= 0) { | |
54 n = i; | |
55 break; | |
56 } | |
57 lp1 += m; | |
58 continue; | |
59 } | |
60 lp0 = lp; | |
61 lp = lp1 = F77_aloc(L = ll, "s_cat"); | |
62 break; | |
63 } | |
64 lp1 = lp; | |
65 #endif /* NO_OVERWRITE */ | |
66 for(i = 0 ; i < n ; ++i) { | |
67 nc = ll; | |
68 if(rnp[i] < nc) | |
69 nc = rnp[i]; | |
70 ll -= nc; | |
71 rp = rpp[i]; | |
72 while(--nc >= 0) | |
73 *lp++ = *rp++; | |
74 } | |
75 while(--ll >= 0) | |
76 *lp++ = ' '; | |
77 #ifndef NO_OVERWRITE | |
78 if (lp0) { | |
79 memcpy(lp0, lp1, L); | |
80 free(lp1); | |
81 } | |
82 #endif | |
83 } | |
84 #ifdef __cplusplus | |
85 } | |
86 #endif |