schain Files · schainf/Ffiles/pythag.f

fix line 461 y 665

rflores - - Load All Authors

File last commit:

r1601:3b2826fe0d97


                r1791:e4984c469c9f

isr

Download file

             pythag.f
        
                    20 lines
            
             | 462 B
            
                | text/x-fortran
            
             |
                FortranFixedLexer
            
             / schainf / Ffiles / pythag.f
          
                    History
                
                 |
                  Annotation
                 | Raw
                 |Copy content
                 |Copy permalink

            real function pythag(a,b)

            real a,b

      c

      c     finds sqrt(a**2+b**2) without overflow or destructive underflow

      c

            real p,r,s,t,u

            p = amax1(abs(a),abs(b))

            if (p .eq. 0.0e0) go to 20

            r = (amin1(abs(a),abs(b))/p)**2

         10 continue

               t = 4.0e0 + r

               if (t .eq. 4.0e0) go to 20

               s = r/t

               u = 1.0e0 + 2.0e0*s

               p = u*p

               r = (s/u)**2 * r

            go to 10

         20 pythag = p

            return

            end

	Site-wide shortcuts
/	Use quick search box
g h	Goto home page
g g	Goto my private gists page
g G	Goto my public gists page
g 0-9	Goto bookmarked items from 0-9
n r	New repository page
n g	New gist page

	Repositories
g s	Goto summary page
g c	Goto changelog page
g f	Goto files page
g F	Goto files page with file search activated
g p	Goto pull requests page
g o	Goto repository settings
g O	Goto repository access permissions settings
t s	Toggle sidebar on some pages

				real function pythag(a,b)
				real a,b
				c
				c finds sqrt(a2+b2) without overflow or destructive underflow
				c
				real p,r,s,t,u
				p = amax1(abs(a),abs(b))
				if (p .eq. 0.0e0) go to 20
				r = (amin1(abs(a),abs(b))/p)**2
				10 continue
				t = 4.0e0 + r
				if (t .eq. 4.0e0) go to 20
				s = r/t
				u = 1.0e0 + 2.0e0*s
				p = u*p
				r = (s/u)*2 r
				go to 10
				20 pythag = p
				return
				end