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