ctan.f 1.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950
  1. *DECK CTAN
  2. COMPLEX FUNCTION CTAN (Z)
  3. C***BEGIN PROLOGUE CTAN
  4. C***PURPOSE Compute the complex tangent.
  5. C***LIBRARY SLATEC (FNLIB)
  6. C***CATEGORY C4A
  7. C***TYPE COMPLEX (CTAN-C)
  8. C***KEYWORDS ELEMENTARY FUNCTIONS, FNLIB, TANGENT, TRIGONOMETRIC
  9. C***AUTHOR Fullerton, W., (LANL)
  10. C***DESCRIPTION
  11. C
  12. C CTAN(Z) calculates the complex trigonometric tangent of complex
  13. C argument Z. Z is in units of radians.
  14. C
  15. C***REFERENCES (NONE)
  16. C***ROUTINES CALLED R1MACH, XERCLR, XERMSG
  17. C***REVISION HISTORY (YYMMDD)
  18. C 770401 DATE WRITTEN
  19. C 890531 Changed all specific intrinsics to generic. (WRB)
  20. C 890531 REVISION DATE from Version 3.2
  21. C 891214 Prologue converted to Version 4.0 format. (BAB)
  22. C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
  23. C***END PROLOGUE CTAN
  24. COMPLEX Z
  25. SAVE SQEPS
  26. DATA SQEPS /0./
  27. C***FIRST EXECUTABLE STATEMENT CTAN
  28. IF (SQEPS.EQ.0.) SQEPS = SQRT (R1MACH(4))
  29. C
  30. X2 = 2.0*REAL(Z)
  31. Y2 = 2.0*AIMAG(Z)
  32. C
  33. SN2X = SIN (X2)
  34. CALL XERCLR
  35. C
  36. DEN = COS(X2) + COSH(Y2)
  37. IF (DEN .EQ. 0.) CALL XERMSG ('SLATEC', 'CTAN',
  38. + 'TAN IS SINGULAR FOR INPUT Z (X IS PI/2 OR 3*PI/2 AND Y IS 0)',
  39. + 2, 2)
  40. C
  41. IF (ABS(DEN).GT.MAX(ABS(X2),1.)*SQEPS) GO TO 10
  42. CALL XERCLR
  43. CALL XERMSG ('SLATEC', 'CTAN',
  44. + 'ANSWER LT HALF PRECISION, ABS(X) TOO BIG OR X TOO NEAR ' //
  45. + 'PI/2 OR 3*PI/2', 1, 1)
  46. C
  47. 10 CTAN = CMPLX (SN2X/DEN, SINH(Y2)/DEN)
  48. C
  49. RETURN
  50. END