|
|
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.