lpc10/f2clib.c

   1 /*
   2
   3 $Log: f2clib.c,v $
   4 Revision 1.2  2007/04/18 13:59:59  rrt
   5 Remove $Log tokens and associated log messages (in many files, several
   6 copies of every log message were being written) and lots of warnings.
   7
   8 Revision 1.1  2007/04/16 21:57:06  rrt
   9 LPC-10 support, documentation still to come; I wanted to land the code
  10 before 14.0.0 went into test, and I'll be busy tomorrow.
  11
  12 Not highly tested either, but it's just a format, doesn't interfere
  13 with anything else, and I'll get on that case before we go stable.
  14
  15  * Revision 1.1  1996/08/19  22:32:10  jaf
  16  * Initial revision
  17  *
  18
  19 */
  20
  21 /*
  22  * f2clib.c
  23  *
  24  * SCCS ID:  @(#)f2clib.c 1.2 96/05/19
  25  */
  26
  27 #include "f2c.h"
  28
  29 integer pow_ii(integer *ap, integer *bp);
  30
  31 integer pow_ii(integer *ap, integer *bp)
  32 {
  33         integer pow, x, n;
  34         unsigned long u;
  35
  36         x = *ap;
  37         n = *bp;
  38
  39         if (n <= 0) {
  40                 if (n == 0 || x == 1)
  41                         return 1;
  42                 if (x != -1)
  43                         return x == 0 ? 1/x : 0;
  44                 n = -n;
  45                 }
  46         u = n;
  47         for(pow = 1; ; )
  48                 {
  49                 if(u & 01)
  50                         pow *= x;
  51                 if(u >>= 1)
  52                         x *= x;
  53                 else
  54                         break;
  55                 }
  56         return(pow);
  57         }
  58
  59
  60 double r_sign(real *a, real *b);
  61
  62 double r_sign(real *a, real *b)
  63 {
  64 double x;
  65 x = (*a >= 0 ? *a : - *a);
  66 return( *b >= 0 ? x : -x);
  67 }
  68
  69
  70 integer i_nint(real *x);
  71
  72 #undef abs
  73 #include "math.h"
  74 integer i_nint(real *x)
  75 {
  76 return( (*x)>=0 ?
  77         floor(*x + .5) : -floor(.5 - *x) );
  78 }