home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / eispack-1.0-src.tgz / tar.out / contrib / eispack / csroot.f < prev    next >
Text File  |  1996-09-28  |  504b  |  18 lines
  1.       subroutine csroot(xr,xi,yr,yi)
  2.       double precision xr,xi,yr,yi
  3. c
  4. c     (yr,yi) = complex dsqrt(xr,xi) 
  5. c     branch chosen so that yr .ge. 0.0 and sign(yi) .eq. sign(xi)
  6. c
  7.       double precision s,tr,ti,pythag
  8.       tr = xr
  9.       ti = xi
  10.       s = dsqrt(0.5d0*(pythag(tr,ti) + dabs(tr)))
  11.       if (tr .ge. 0.0d0) yr = s
  12.       if (ti .lt. 0.0d0) s = -s
  13.       if (tr .le. 0.0d0) yi = s
  14.       if (tr .lt. 0.0d0) yr = 0.5d0*(ti/yi)
  15.       if (tr .gt. 0.0d0) yi = 0.5d0*(ti/yr)
  16.       return
  17.       end
  18.