mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
39 lines
1 KiB
Fortran
39 lines
1 KiB
Fortran
*DECK PYTHAG
|
|
REAL FUNCTION PYTHAG (A, B)
|
|
C***BEGIN PROLOGUE PYTHAG
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Compute the complex square root of a complex number without
|
|
C destructive overflow or underflow.
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (PYTHAG-S)
|
|
C***AUTHOR (UNKNOWN)
|
|
C***DESCRIPTION
|
|
C
|
|
C Finds sqrt(A**2+B**2) without overflow or destructive underflow
|
|
C
|
|
C***SEE ALSO EISDOC
|
|
C***ROUTINES CALLED (NONE)
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 811101 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900402 Added TYPE section. (WRB)
|
|
C***END PROLOGUE PYTHAG
|
|
REAL A,B
|
|
C
|
|
REAL P,Q,R,S,T
|
|
C***FIRST EXECUTABLE STATEMENT PYTHAG
|
|
P = MAX(ABS(A),ABS(B))
|
|
Q = MIN(ABS(A),ABS(B))
|
|
IF (Q .EQ. 0.0E0) GO TO 20
|
|
10 CONTINUE
|
|
R = (Q/P)**2
|
|
T = 4.0E0 + R
|
|
IF (T .EQ. 4.0E0) GO TO 20
|
|
S = R/T
|
|
P = P + 2.0E0*P*S
|
|
Q = Q*S
|
|
GO TO 10
|
|
20 PYTHAG = P
|
|
RETURN
|
|
END
|