a40bb4d345
2000-12-09 Toon Moene <toon@moene.indiv.nluug.nl> Update to Netlib version 20001205. Thanks go to David M. Gay for these updates. * libF77/Version.c: Update version information. * libF77/z_log.c: Improve accuracy of real(log(z)) for z near (+-1,eps) with |eps| small. * libF77/s_cat.c: Adjust call when ftnint and ftnlen are of different size. * libF77/dtime_.c, libF77/etime_.c: Use floating point divide. * libI77/Version.c: Update version information. * libI77/rsne.c, libI77/xwsne.c: Adjust code for when ftnint and ftnlen differ in size. * libI77/lread.c: Fix reading of namelist logical values followed by <name>= where <name> starts with T or F. From-SVN: r38152
76 lines
1.3 KiB
C
76 lines
1.3 KiB
C
/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
|
|
* target of a concatenation to appear on its right-hand side (contrary
|
|
* to the Fortran 77 Standard, but in accordance with Fortran 90).
|
|
*/
|
|
|
|
#include "f2c.h"
|
|
#ifndef NO_OVERWRITE
|
|
#include <stdio.h>
|
|
#undef abs
|
|
#ifdef KR_headers
|
|
extern char *F77_aloc();
|
|
extern void free();
|
|
extern void G77_exit_0 ();
|
|
#else
|
|
#undef min
|
|
#undef max
|
|
#include <stdlib.h>
|
|
extern char *F77_aloc(ftnlen, char*);
|
|
#endif
|
|
#include <string.h>
|
|
#endif /* NO_OVERWRITE */
|
|
|
|
VOID
|
|
#ifdef KR_headers
|
|
s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll;
|
|
#else
|
|
s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll)
|
|
#endif
|
|
{
|
|
ftnlen i, nc;
|
|
char *rp;
|
|
ftnlen n = *np;
|
|
#ifndef NO_OVERWRITE
|
|
ftnlen L, m;
|
|
char *lp0, *lp1;
|
|
|
|
lp0 = 0;
|
|
lp1 = lp;
|
|
L = ll;
|
|
i = 0;
|
|
while(i < n) {
|
|
rp = rpp[i];
|
|
m = rnp[i++];
|
|
if (rp >= lp1 || rp + m <= lp) {
|
|
if ((L -= m) <= 0) {
|
|
n = i;
|
|
break;
|
|
}
|
|
lp1 += m;
|
|
continue;
|
|
}
|
|
lp0 = lp;
|
|
lp = lp1 = F77_aloc(L = ll, "s_cat");
|
|
break;
|
|
}
|
|
lp1 = lp;
|
|
#endif /* NO_OVERWRITE */
|
|
for(i = 0 ; i < n ; ++i) {
|
|
nc = ll;
|
|
if(rnp[i] < nc)
|
|
nc = rnp[i];
|
|
ll -= nc;
|
|
rp = rpp[i];
|
|
while(--nc >= 0)
|
|
*lp++ = *rp++;
|
|
}
|
|
while(--ll >= 0)
|
|
*lp++ = ' ';
|
|
#ifndef NO_OVERWRITE
|
|
if (lp0) {
|
|
memcpy(lp0, lp1, L);
|
|
free(lp1);
|
|
}
|
|
#endif
|
|
}
|