home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / eispack-1.0-src.tgz / tar.out / contrib / eispack / pythag.f < prev    next >
Text File  |  1996-09-28  |  503b  |  21 lines
  1.       double precision function pythag(a,b)
  2.       double precision a,b
  3. c
  4. c     finds dsqrt(a**2+b**2) without overflow or destructive underflow
  5. c
  6.       double precision p,r,s,t,u
  7.       p = dmax1(dabs(a),dabs(b))
  8.       if (p .eq. 0.0d0) go to 20
  9.       r = (dmin1(dabs(a),dabs(b))/p)**2
  10.    10 continue
  11.          t = 4.0d0 + r
  12.          if (t .eq. 4.0d0) go to 20
  13.          s = r/t
  14.          u = 1.0d0 + 2.0d0*s
  15.          p = u*p
  16.          r = (s/u)**2 * r
  17.       go to 10
  18.    20 pythag = p
  19.       return
  20.       end
  21.