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