Skip to content
Snippets Groups Projects
f2clib.c 1.16 KiB
Newer Older
  • Learn to ignore specific revisions
  • Mark Spencer's avatar
    Mark Spencer committed
    /*
    
    $Log$
    
    Revision 1.14  2003/02/12 13:59:15  matteo
    mer feb 12 14:56:57 CET 2003
    
    Revision 1.1.1.1  2003/02/12 13:59:15  matteo
    mer feb 12 14:56:57 CET 2003
    
    Mark Spencer's avatar
    Mark Spencer committed
    
    Revision 1.2  2000/01/05 08:20:39  markster
    Some OSS fixes and a few lpc changes to make it actually work
    
     * Revision 1.1  1996/08/19  22:32:10  jaf
     * Initial revision
     *
    
    */
    
    /*
     * f2clib.c
     *
     * SCCS ID:  @(#)f2clib.c 1.2 96/05/19
     */
    
    #include "f2c.h"
    
    #ifdef KR_headers
    integer pow_ii(ap, bp) integer *ap, *bp;
    #else
    integer pow_ii(integer *ap, integer *bp)
    #endif
    {
    	integer pow, x, n;
    	unsigned long u;
    
    	x = *ap;
    	n = *bp;
    
    	if (n <= 0) {
    		if (n == 0 || x == 1)
    			return 1;
    		if (x != -1)
    
    Mark Spencer's avatar
    Mark Spencer committed
    		n = -n;
    		}
    	u = n;
    	for(pow = 1; ; )
    		{
    		if(u & 01)
    			pow *= x;
    		if(u >>= 1)
    			x *= x;
    		else
    			break;
    		}
    	return(pow);
    	}
    
    
    
    #ifdef KR_headers
    double r_sign(a,b) real *a, *b;
    #else
    double r_sign(real *a, real *b)
    #endif
    {
    double x;
    x = (*a >= 0 ? *a : - *a);
    return( *b >= 0 ? x : -x);
    }
    
    
    
    #ifdef KR_headers
    double floor();
    integer i_nint(x) real *x;
    #else
    #undef abs
    #include "math.h"
    integer i_nint(real *x)
    #endif
    {
    
    return( (integer)((*x)>=0 ?
    	floor(*x + .5) : -floor(.5 - *x)) );
    
    Mark Spencer's avatar
    Mark Spencer committed
    }