ccot.f 1.5 KB

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