f2clib.c

Go to the documentation of this file.
00001 /*
00002 
00003 $Log$
00004 Revision 1.14  2003/02/12 13:59:15  matteo
00005 mer feb 12 14:56:57 CET 2003
00006 
00007 Revision 1.1.1.1  2003/02/12 13:59:15  matteo
00008 mer feb 12 14:56:57 CET 2003
00009 
00010 Revision 1.2  2000/01/05 08:20:39  markster
00011 Some OSS fixes and a few lpc changes to make it actually work
00012 
00013  * Revision 1.1  1996/08/19  22:32:10  jaf
00014  * Initial revision
00015  *
00016 
00017 */
00018 
00019 /*
00020  * f2clib.c
00021  *
00022  * SCCS ID:  @(#)f2clib.c 1.2 96/05/19
00023  */
00024 
00025 #include "f2c.h"
00026 
00027 #ifdef KR_headers
00028 integer pow_ii(ap, bp) integer *ap, *bp;
00029 #else
00030 integer pow_ii(integer *ap, integer *bp)
00031 #endif
00032 {
00033    integer pow, x, n;
00034    unsigned long u;
00035 
00036    x = *ap;
00037    n = *bp;
00038 
00039    if (n <= 0) {
00040       if (n == 0 || x == 1)
00041          return 1;
00042       if (x != -1)
00043          return x == 0 ? 0 : 1/x;
00044       n = -n;
00045       }
00046    u = n;
00047    for(pow = 1; ; )
00048       {
00049       if(u & 01)
00050          pow *= x;
00051       if(u >>= 1)
00052          x *= x;
00053       else
00054          break;
00055       }
00056    return(pow);
00057    }
00058 
00059 
00060 
00061 #ifdef KR_headers
00062 double r_sign(a,b) real *a, *b;
00063 #else
00064 double r_sign(real *a, real *b)
00065 #endif
00066 {
00067 double x;
00068 x = (*a >= 0 ? *a : - *a);
00069 return( *b >= 0 ? x : -x);
00070 }
00071 
00072 
00073 
00074 #ifdef KR_headers
00075 double floor();
00076 integer i_nint(x) real *x;
00077 #else
00078 #undef abs
00079 #include "math.h"
00080 integer i_nint(real *x)
00081 #endif
00082 {
00083 return( (integer)((*x)>=0 ?
00084    floor(*x + .5) : -floor(.5 - *x)) );
00085 }

Generated on Thu Apr 16 06:27:34 2015 for Asterisk - The Open Source Telephony Project by  doxygen 1.5.6