binaries/src/disembl/Tisean_3.0.1/source_f/slatec/pythag.f

   1 *DECK PYTHAG
   2       REAL FUNCTION PYTHAG (A, B)
   3 C***BEGIN PROLOGUE  PYTHAG
   4 C***SUBSIDIARY
   5 C***PURPOSE  Compute the complex square root of a complex number without
   6 C            destructive overflow or underflow.
   7 C***LIBRARY   SLATEC
   8 C***TYPE      SINGLE PRECISION (PYTHAG-S)
   9 C***AUTHOR  (UNKNOWN)
  10 C***DESCRIPTION
  11 C
  12 C     Finds sqrt(A**2+B**2) without overflow or destructive underflow
  13 C
  14 C***SEE ALSO  EISDOC
  15 C***ROUTINES CALLED  (NONE)
  16 C***REVISION HISTORY  (YYMMDD)
  17 C   811101  DATE WRITTEN
  18 C   890531  Changed all specific intrinsics to generic.  (WRB)
  19 C   891214  Prologue converted to Version 4.0 format.  (BAB)
  20 C   900402  Added TYPE section.  (WRB)
  21 C***END PROLOGUE  PYTHAG
  22       REAL A,B
  23 C
  24       REAL P,Q,R,S,T
  25 C***FIRST EXECUTABLE STATEMENT  PYTHAG
  26       P = MAX(ABS(A),ABS(B))
  27       Q = MIN(ABS(A),ABS(B))
  28       IF (Q .EQ. 0.0E0) GO TO 20
  29    10 CONTINUE
  30          R = (Q/P)**2
  31          T = 4.0E0 + R
  32          IF (T .EQ. 4.0E0) GO TO 20
  33          S = R/T
  34          P = P + 2.0E0*P*S
  35          Q = Q*S
  36       GO TO 10
  37    20 PYTHAG = P
  38       RETURN
  39       END