/* 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