V3FIT
pythag.f
1  FUNCTION pythag (a, b)
2  USE stel_kinds
3  IMPLICIT NONE
4 C-----------------------------------------------
5 C D u m m y A r g u m e n t s
6 C-----------------------------------------------
7  REAL(rprec) a, b
8 C-----------------------------------------------
9 C L o c a l P a r a m e t e r s
10 C-----------------------------------------------
11  REAL(rprec) :: zero = 0, one = 1
12 C-----------------------------------------------
13 C L o c a l V a r i a b l e s
14 C-----------------------------------------------
15  REAL(rprec) :: absa, absb, pythag
16 C-----------------------------------------------
17 c computes SQRT(a^2+b^2) without destructive underflow or overflow
18  absa = abs(a)
19  absb = abs(b)
20  IF (absa .gt. absb) THEN
21  pythag = absa*sqrt(one + (absb/absa)**2)
22  ELSE
23  IF (absb .eq. zero) THEN
24  pythag = zero
25  ELSE
26  pythag = absb*sqrt(one + (absa/absb)**2)
27  END IF
28  END IF
29 
30  END FUNCTION pythag