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
pow_ii(integer * ap,integer * bp)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
r_sign(real * a,real * b)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"
i_nint(real * x)74 integer i_nint(real *x)
75 {
76 return( (*x)>=0 ?
77 floor(*x + .5) : -floor(.5 - *x) );
78 }
79