codecs/lpc10/f2clib.c

   1 /*
   2
   3 $Log$
   4 Revision 1.5  2000/01/05 08:20:39  markster
   5 Version 0.1.6 from FTP
   6
   7 Revision 1.2  2000/01/05 08:20:39  markster
   8 Some OSS fixes and a few lpc changes to make it actually work
   9
  10  * Revision 1.1  1996/08/19  22:32:10  jaf
  11  * Initial revision
  12  *
  13
  14 */
  15
  16 /*
  17  * f2clib.c
  18  *
  19  * SCCS ID:  @(#)f2clib.c 1.2 96/05/19
  20  */
  21
  22 #include "f2c.h"
  23
  24 #ifdef KR_headers
  25 integer pow_ii(ap, bp) integer *ap, *bp;
  26 #else
  27 integer pow_ii(integer *ap, integer *bp)
  28 #endif
  29 {
  30         integer pow, x, n;
  31         unsigned long u;
  32
  33         x = *ap;
  34         n = *bp;
  35
  36         if (n <= 0) {
  37                 if (n == 0 || x == 1)
  38                         return 1;
  39                 if (x != -1)
  40                         return x == 0 ? 1/x : 0;
  41                 n = -n;
  42                 }
  43         u = n;
  44         for(pow = 1; ; )
  45                 {
  46                 if(u & 01)
  47                         pow *= x;
  48                 if(u >>= 1)
  49                         x *= x;
  50                 else
  51                         break;
  52                 }
  53         return(pow);
  54         }
  55
  56
  57
  58 #ifdef KR_headers
  59 double r_sign(a,b) real *a, *b;
  60 #else
  61 double r_sign(real *a, real *b)
  62 #endif
  63 {
  64 double x;
  65 x = (*a >= 0 ? *a : - *a);
  66 return( *b >= 0 ? x : -x);
  67 }
  68
  69
  70
  71 #ifdef KR_headers
  72 double floor();
  73 integer i_nint(x) real *x;
  74 #else
  75 #undef abs
  76 #include "math.h"
  77 integer i_nint(real *x)
  78 #endif
  79 {
  80 return( (*x)>=0 ?
  81         floor(*x + .5) : -floor(.5 - *x) );
  82 }