/* fhelp.c Contains functions needed by code converted
from Fortran. */
/*>> 1998-01-20 Krogh Got rid of MAX and MIN -- had conflict somewhere. */
/*>> 1998-01-28 Krogh Fixed bug in ntstr, if (next >= NTSTR) next=0; */
/*>> 1994-06-21 CLL Added more functions for type: float. */
/*>> 1993-04-07 C. L. Lawson, JPL */
/*>> 1993-02-23 C. L. Lawson, JPL */
/*>> 1993-01-15 C. L. Lawson, JPL */
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include "fcrt.h"
/* externals for use in macros TO AVOID side effects */
char *f_s_, f_c_;
short f_si_;
long f_l_;
double f_d_;
float f_f_;
#ifndef INLN_SIGN
double sign(double, double); /* floating point sign transfer */
float signf(float, float); /* floating point sign transfer */
long isign(long, long); /* sign transfer */
#endif
/* Also contains string handling functions:
ntstr()
ct_alloc()
f_concat() -- F77 str concat operation
f_strcmp() -- F77 str comparisons
f_strncpy() -- F77 str assignment transl.
f_subs() -- extracts F77 substr
f_subscpy() -- assigns F77 substrs
ini_chrtmp()-- initializes the char temps
nulltermsa()
rel_chrtmp()-- releases the space assoc. w/chrtmps
strcate()
void f_err(char* msg);
istrstr()
lstrstr()
strstr()
*/
/* */
#ifndef INLN_MXMN
double /*FUNCTION*/ fmin(double x1, double x2)
{
if (x1 <= x2 )
return(x1);
else
return(x2);
}
double /*FUNCTION*/ fmax(double x1, double x2)
{
if (x1 >= x2 )
return(x1);
else
return(x2);
}
float /*FUNCTION*/ fminf(float x1, float x2)
{
if (x1 <= x2 )
return(x1);
else
return(x2);
}
float /*FUNCTION*/ fmaxf(float x1, float x2)
{
if (x1 >= x2 )
return(x1);
else
return(x2);
}
long /*FUNCTION*/ min(long x1, long x2)
{
if (x1 <= x2 )
return(x1);
else
return(x2);
}
long /*FUNCTION*/ max(long x1, long x2)
{
if (x1 >= x2 )
return(x1);
else
return(x2);
}
#endif
/* Min & max for more than two arguments, no longer used.
double fmin3(double, double, double);
double fmax3(double, double, double);
double fmin4(double, double, double, double);
double fmax4(double, double, double, double);
float fmin3f(float, float, float);
float fmax3f(float, float, float);
float fmin4f(float, float, float, float);
float fmax4f(float, float, float, float);
long min3(long, long, long);
long max3(long, long, long);
double fmin3(double a, double b, double c)
{
double fmin3_v;
fmin3_v = fmin( a, fmin( b, c ) );
return( fmin3_v );
}
double fmax3(double a, double b, double c)
{
double fmax3_v;
fmax3_v = fmax( a, fmax( b, c ) );
return( fmax3_v );
}
double fmin4(double a, double b, double c, double d)
{
double fmin4_v;
fmin4_v = fmin( a, fmin( b, fmin( c, d ) ) );
return( fmin4_v );
}
double fmax4(double a, double b, double c, double d)
{
double fmax4_v;
fmax4_v = fmax( a, fmax( b, fmax( c, d ) ) );
return( fmax4_v );
}
float fmin3f(float a, float b, float c)
{
float fmin3_v;
fmin3_v = fmin( a, fmin( b, c ) );
return( fmin3_v );
}
float fmax3f(float a, float b, float c)
{
float fmax3_v;
fmax3_v = fmax( a, fmax( b, c ) );
return( fmax3_v );
}
float fmin4f(float a, float b, float c, float d)
{
float fmin4_v;
fmin4_v = fmin( a, fmin( b, fmin( c, d ) ) );
return( fmin4_v );
}
float fmax4f(float a, float b, float c, float d)
{
float fmax4_v;
fmax4_v = fmax( a, fmax( b, fmax( c, d ) ) );
return( fmax4_v );
}
long min3(long a, long b, long c)
{
long min3_v;
min3_v = min( a, min( b, c ) );
return( min3_v );
}
long max3(long a, long b, long c)
{
long max3_v;
max3_v = max( a, max( b, c ) );
return( max3_v );
}
*/
/* powi.c - calc x^n, where n is an integer. */
/* Very slightly modified version of power() from Computer Language, Sept. 86,
pg 87, by Jon Snader (who extracted the binary algorithm from Donald Knuth,
"The Art of Computer Programming", vol 2, 1969).
powi() will only be called when an exponentiation with an integer
exponent is performed, thus tests & code for fractional exponents were
removed. -- cw lightfoot, COBALT BLUE
COBALT BLUE has NO copyright on the functions in this file. The source may
be considered public domain.
*/
/* #include <stdio.h>
#include "fcrt.h" */
#define IS_ODD(j) ((j) & 1 )
double /*FUNCTION*/ powi( double x, long n ) /* returns: x^n */
{
double p; /* holds partial product */
if( x == 0 )
return( 0. );
if( n < 0 ){ /* test for negative exponent */
n = -n;
x = 1/x;
}
p = IS_ODD(n) ? x : 1; /* test & set zero power */
while( n >>= 1 ){ /* now do the other powers */
x *= x; /* sq previous power of x */
if( IS_ODD(n) ) /* if low order bit set */
p *= x; /* then, multiply partial product by latest power of x */
}
return( p );
}
float /*FUNCTION*/ powif( float x, long n ) /* returns: x^n */
{
float p; /* holds partial product */
if( x == 0 )
return( 0. );
if( n < 0 ){ /* test for negative exponent */
n = -n;
x = 1/x;
}
p = IS_ODD(n) ? x : 1; /* test & set zero power */
while( n >>= 1 ){ /* now do the other powers */
x *= x; /* sq previous power of x */
if( IS_ODD(n) ) /* if low order bit set */
p *= x; /* then, multiply partial product by latest power of x */
}
return( p );
}
/* * * * */
long /*FUNCTION*/ ipow( long m, long n ) /* returns: m^n */
{
long p; /* holds partial product */
if( m == 0 )
return( 0L );
if( n < 0 ){ /* test for negative exponent */
n = -n;
m = 1/m;
}
p = IS_ODD(n) ? m : 1; /* test & set zero power */
while( n >>= 1 ){ /* now do the other powers */
m *= m; /* sq previous power of m */
if( IS_ODD(n) ) /* if low order bit set */
p *= m; /* then, multiply partial product by latest power of m */
}
return( p );
}
/* sign.c - support for F77 sign() function translations
by FOR_C (TM) from COBALT BLUE
copyright Lightfoot & Associates, Inc., 1987 - 1990
ALL RIGHTS RESERVED
*/
#ifndef INLN_SIGN
#ifdef sign
#undef sign
#endif
double /*FUNCTION*/ sign( double a, double b ) /* floating point sign transfer */
/* (sign(), dsign() in F77) */
{
return( b < 0 ? -ABS(a) : ABS(a) );
}
#ifdef signf
#undef signf
#endif
float /*FUNCTION*/ signf( float a, float b ) /* floating point sign transfer */
/* (sign() in F77) */
{
return( b < 0 ? -ABS(a) : ABS(a) );
}
#ifdef isign
#undef isign
#endif
long /*FUNCTION*/ isign( long a, long b ) /* long int sign transfer */
/* (isign() in F77) */
{
return( b < 0L ? -ABS(a) : ABS(a) );
}
#endif /* INLN_SIGN */
/* * * * */
/* ntstr.c - convert length specified memory to null terminated string
FOR_C (TM) from COBALT BLUE
copyright Lightfoot & Associates, Inc., 1990
ALL RIGHTS RESERVED
*/
/* #include <stdio.h> */ /* for NULL definition */
/* #include <stdlib.h> */
#define MX_NTS 64
static char *nts[MX_NTS];
static int next=0;
/* rotate through nts[] ptrs to avoid clobbering prior values when
used in an argument list */
char *ntstr( obj, n )
void *obj;
long n; /* the size of the object to null terminate */
{
int i;
char *o=obj, *t;
if( n <= 0 )
return( "" ); /* null string since invalid length */
if (next >= MX_NTS) next = 0;
if( nts[next] )
free( nts[next] ); /* free prior string */
if( (nts[next]=malloc(n+1)) == NULL )
f_err( "ntstr: can't allocate space" );
/* NOTE: +1 to allow for \0 at the end of the new string */
for( i=0,t=nts[next]; i < n; i++ ){
/* copy the object to the null terminated space */
if( *o )
*t = *o;
else
*t = ' '; /* convert interior nulls to blanks */
t++; o++;
}
*t = '\0'; /* null terminate the string */
return( nts[next++] );
}
/* strmgt.c - str mngt. for transl. F77 char exprs
by FOR_C (TM) from COBALT BLUE
copyright Lightfoot & Associates, Inc., 1988 - 1990
ALL RIGHTS RESERVED
*/
/* contains: f_concat() -- F77 str concat operation
f_strcmp() -- F77 str comparisons
f_strncpy() -- F77 str assignment transl.
f_subs() -- extracts F77 substr
f_subscpy() -- assigns F77 substrs
ini_chrtmp()-- initializes the char temps
rel_chrtmp()-- releases the space assoc. w/chrtmps
*/
/* #include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "fcrt.h" */
#ifdef __STDC__
#include <stdarg.h> /* ANSI variable arg macros */
#else
#include <varargs.h>
#endif
#define EXCESS 50
/* NOTE: reduce EXCESS to reallocate more often and minimize
unused large blocks of memory, more runtime (& possibly
more memory fragmentation) result from smaller EXCESSes */
#ifdef PROTOTYPES
void ct_alloc(CHRTMP*,long); /* allocate space for char temporary */
#else
void ct_alloc();
#endif
char null_ct_[] = "NULL CHRTMP pointer in f_concat() or f_subs()";
/* * * * */
void ct_alloc( tmp, len ) /* allocate space for char temporary */
CHRTMP *tmp;
long len; /* the new tmp string length */
{
/* NOTE: the chrtmp array is initialized to 0 size & NULL ptrs */
if( len > 65534 )
f_err( "temp string requires too much space" );
if( tmp->s != NULL )
free( tmp->s ); /* free the current temp space */
/* allocate new space for the temp */
if( (tmp->s=malloc((unsigned)len+1)) == NULL )
f_err( "unable to allocate space for str temp" );
tmp->siz = (unsigned) len;
return;
}
/* * * * */
/* VARIABLE NUMBER OF ARGUMENTS ANSI FUNCTION */
/* concat strs, retn the addr of tmp space */
#ifdef __STDC__
char *f_concat( CHRTMP *tmp, ... )
#else
char *f_concat( tmp, va_alist )
CHRTMP *tmp;
va_dcl
#endif
{
char *str, *t;
long len=0L; /* the total length of the tmp */
va_list args; /* arg ptr */
if( tmp == NULL )
f_err( null_ct_ );
/* 1st - determine the necessary size of the temp */
#ifdef __STDC__ /* ANSI C */
va_start(args,tmp); /* initialize variable args */
#else /* UNIX System V C */
va_start(args); /* initialize variable args */
#endif
for( str=va_arg(args,char*); str!=NULL; str=va_arg(args,char*) )
len += strlen(str);
va_end(args); /* reset variable args */
if( len == 0 ){
*(tmp->s) = '\0'; /* nothing is being concatenated */
return( tmp->s ); /* (shouldn't occur in F77 char ops) */
}
/* 2nd - free the current temp space */
if( tmp->siz < len || (tmp->siz - len) > EXCESS )
ct_alloc( tmp, len );
/* 3rd - concatenate the strings to temp */
#ifdef __STDC__ /* ANSI C */
va_start(args,tmp); /* initialize variable args */
#else /* UNIX System V C */
va_start(args); /* initialize variable args */
#endif
*(t=tmp->s) = '\0'; /* initialize the local ptr */
for( str=va_arg(args,char*); str!=NULL; str=va_arg(args,char*) )
t = strcate( t, str );
/* NOTE: strcate() retns the new end of 't', rather than
the beginning, for faster repeated concatenations */
return( tmp->s );
}
/* * * * */
int f_strcmp( left, right ) /* F77 str comparison */
char *left, *right; /* retns <0 if l < r, 0 if equal, or >0 if l > r */
{
/* f_strcmp() effectively blank fills the shorter str for the comparison,
but otherwise functions the same as strcmp() */
int l, r;
if( left==NULL || right==NULL )
return( left ? 1 : (right? -1: 0) );
while( *left || *right ){
l = *left ? *left++ : ' ';
r = *right ? *right++ : ' ';
if( l != r )
return( l - r );
/* NOTE: This function assumes an ASCII character set!
If not, then the character set should be designed
so that the values of the characters correspond to
the position of the letters in the alphabet, (i.e.,
'a' should be < 'b'), otherwise the function will
need to be re-written as appropriate. */
}
return( 0 ); /* equal strings */
}
/* * * * */
char *f_strncpy( to, from, n ) /* F77 str assignment transl. */
char *to, *from;
int n; /* no. of chars to copy, (blank filled if length(from) < n) */
{
char *t=to;
if( to==NULL || from==NULL )
return( NULL ); /* no chg or action if NULL strs given */
if( n <= 0 )
return( NULL ); /* undefined */
while( n>0 && *from ){ /* copy the string (subject to n) */
*t++ = *from++;
n--;
}
while( n > 0 ){ /* blank fill (since length(from) < n) */
*t++ = ' ';
n--;
}
*t = '\0';
return( to );
}
/* * * * */
char *f_subs(tmp,s,start,end) /* copy substr to tmp space, retn tmp addr */
CHRTMP *tmp;
char *s; /* the string containing the substring */
int start, end; /* substring bounds ASSUME C range, (ie., start at 0) */
{
char *b, *t;
long len=0L; /* substring length, (& hence tmp length) */
/* input checks */
if( tmp == NULL )
f_err( null_ct_ );
if( s == NULL )
return( NULL ); /* NO chg or action if null substr given */
/* 1st - determine the substring length (& tmp size) */
start = (start > 0 ? start : 0);
len = (end-start+1 > 0 ? end-start+1 : 0);
/* 2nd - free the current temp space if necessary */
if( tmp->siz < len || (tmp->siz - len) > EXCESS )
ct_alloc( tmp, len );
/* 3rd - copy substring to temp space */
for( b=s+start,t=tmp->s; len ; len-- ){
if( *b )
*t++ = *b++;
else
*t++ = ' '; /* blank fill rest of substr */
}
*t = '\0';
return( tmp->s );
}
/* * * * */
char *f_subscpy(to,start,end,len,from) /* F77 substr assignment transl. */
char *to, *from;
int start, end, /* substring bounds target string */
len; /* target string length */
{
/* NOTE: f_subscpy() null terminates the target string, the end of
the target string is determined from "to+len"! ! !
The substring bounds assume C range (i.e., start at 0).
*/
char *t;
long n;
/* input checks */
if( to == NULL || from == NULL )
return( NULL ); /* NO chg or action if null str(s) given */
/* 1st - determine the substr length/size, ltd to target str length */
start = (start > 0 ? start : 0);
end = (end < len - 1) ? end : len - 1;
n = (end-start+1 > 0 ? end-start+1 : 0); /* substr length */
/* 2nd - copy substring */
t = to + start;
for( ; n>0 ; n-- ){ /* copy the string (subject to n) */
if( *from )
*t++ = *from++;
else
*t++ = ' '; /* blank fill rest of substr */
}
*(to+len) = '\0'; /* insure the string itself is terminated */
return( to );
}
/* * * * */
void ini_chrtmp(ct,n) /* initialize the chrtmp array */
CHRTMP ct[];
int n;
{
int i;
for( i=0; i < n; i++ ){
ct[i].siz = 0;
ct[i].s = NULL;
}
return;
}
/* * * * */
void nulltermsa( sa, siz, nstrs ) /* null term. an array of strings */
char *sa; /* ptr to the string array */
int siz, /* size of the strings in the array */
nstrs; /* no. of strings in the array */
{
int n;
for( n=1; n <= nstrs; n++ )
*(sa+n*siz-1) = '\0';
return;
}
/* * * * */
void rel_chrtmp( ct, n ) /* release the space assoc. w/chrtmp array */
CHRTMP ct[];
int n;
{
int i;
for( i=0; i < n; i++ ){
if( ct[i].s != NULL )
free( ct[i].s );
ct[i].siz = 0;
}
return;
}
/* * * * */
char *strcate( to, from ) /* add 'from' to 'to' & retn the new END of 'to' */
char *to, *from;
{
while( *to ) /* find end of 'to' */
to++;
while( (*to++ = *from++) ) /* add 'from' , (EOS is copied) */
;
return( --to ); /* retn ptr to the EOS */
}
void f_err( msg ) /* output F77 Runtime error msg & quit */
char *msg;
{
fputs( "FCRT ERROR: ", stderr );
fputs( msg, stderr );
fputc( '\n', stderr );
exit( 1 );
}
/* istrstr.c - char substr location supporting translations by
FOR_C (TM) from COBALT BLUE
copyright Lightfoot & Associates, Inc., 1988, 1990
ALL RIGHTS RESERVED
*/
/* #include <stdio.h> */ /* for NULL definition */
/* #include <string.h> */ /* for decl of strstr() */
/* #include "fcrt.h" */
int istrstr( str, substr ) /* return the int location of substr in str */
char *str, *substr;
{
char *s;
if( (s=strstr(str,substr)) == NULL )
return( 0 ); /* not present */
return( (int)(s-str) + 1 );
}
long lstrstr( str, substr ) /* return the long int location of substr in str */
char *str, *substr;
{
char *s;
if( (s=strstr(str,substr)) == NULL )
return( 0L ); /* not present */
return( (long)(s-str) + 1L );
}
#ifdef NEED_STRSTR
/* NOTE: strstr() is part of the Draft ANSI C Standard, however, if
not present in your std C library, define the above macro switch.
*/
char *strstr(str,sub) /* find the first occurrence of 'sub' in 'str' */
char *str, *sub;
/* retns a pointer to the start of 'sub' in 'str', or NULL if not present */
{
char *s, *b;
if( sub == NULL || str == NULL )
return( NULL );
else if( *sub == '\0' || *str == '\0' ) /* don't deal with null strings */
return( NULL );
for( ; *str; str++){
for( b=str,s=sub; *s == *b && *s ; s++,b++ )
;
if( *s == '\0' ) /* match found if the end of 'sub' was reached */
return( str );
if( *b == '\0' )
break; /* reached the end of 'str' w/o a match */
}
return( NULL );
}
#endif