gcc/f/runtime/libF77/c_sqrt.c

   1 #include "f2c.h"
   2
   3 #ifdef KR_headers
   4 extern double sqrt(), f__cabs();
   5
   6 VOID c_sqrt(resx, z) complex *resx, *z;
   7 #else
   8 #undef abs
   9 #include <math.h>
  10 extern double f__cabs(double, double);
  11
  12 void c_sqrt(complex *resx, complex *z)
  13 #endif
  14 {
  15 double mag, t;
  16 complex res;
  17
  18 if( (mag = f__cabs(z->r, z->i)) == 0.)
  19         res.r = res.i = 0.;
  20 else if(z->r > 0)
  21         {
  22         res.r = t = sqrt(0.5 * (mag + z->r) );
  23         t = z->i / t;
  24         res.i = 0.5 * t;
  25         }
  26 else
  27         {
  28         t = sqrt(0.5 * (mag - z->r) );
  29         if(z->i < 0)
  30                 t = -t;
  31         res.i = t;
  32         t = z->i / t;
  33         res.r = 0.5 * t;
  34         }
  35
  36 resx->r = res.r;
  37 resx->i = res.i;
  38 }