Adding DisEMBL dependency Tisean executable

[jabaws.git] / binaries / src / disembl / Tisean_3.0.1 / source_f / slatec / pythag.f

diff --git a/binaries/src/disembl/Tisean_3.0.1/source_f/slatec/pythag.f b/binaries/src/disembl/Tisean_3.0.1/source_f/slatec/pythag.f
new file mode 100644 (file)
index 0000000..dc3ef31
--- /dev/null
+++ b/binaries/src/disembl/Tisean_3.0.1/source_f/slatec/pythag.f
@@ -0,0 +1,39 @@
+*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