|
|
1.1 root 1: # include "complex.h"
2:
3:
4: #define SQRT_DANGER 1e17
5: # define PERIL(t) (t > SQRT_DANGER || (t < 1/SQRT_DANGER && t != 0))
6:
7: /*
8: *
9: * 7-25-83, note from Leonie Rose -
10: * Stu Feldman says that the peril tests for the following function
11: * are "acceptable" for now, but certain things like
12: * sqrt(1e10 + 1e-30*i) will cause floating exceptions.
13: *
14: */
15:
16: complex sqrt(complex z)
17: {
18: complex answer;
19: double r_old, partial;
20:
21: /*
22: Check for possible overflow, and fixup if necessary.
23: */
24:
25: double x = abs(z.re);
26: double y = abs(z.im);
27:
28: if (x > y && PERIL(x)) {
29: z.im /= x;
30: z.re /= x; /* z.re is replaced by 1 or -1 */
31: partial = sqrt(x);
32: }
33: else if PERIL(y) {
34: z.im /= y; /* roles of z.re, z.im reversed from previous */
35: z.re /= y;
36: partial = sqrt(y);
37: }
38: else partial = 1;
39:
40: /*
41: Main computation:
42: Use half angle formulas to compute angular part of the square root.
43: The sign of sin_old is the same as that for sin_new, which means that the
44: upper half plane gets mapped to the first quadrant, and
45: the lower half plane to the fourth quandrant.
46: */
47:
48:
49: if (r_old = sqrt(z.re*z.re + z.im*z.im)) {
50: double r_new = partial * sqrt(r_old);
51:
52: double cos_old = z.re/r_old;
53: double sin_old = z.im/r_old;
54: double cos_new = sqrt( (1 + cos_old)/2 );
55: double sin_new = (cos_new == 0)? 1 : sin_old/(2*cos_new);
56:
57: answer.re = r_new * cos_new;
58: answer.im = r_new * sin_new;
59: }
60:
61: return answer;
62: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.