c0lgmc.f 1.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142
  1. *DECK C0LGMC
  2. COMPLEX FUNCTION C0LGMC (Z)
  3. C***BEGIN PROLOGUE C0LGMC
  4. C***PURPOSE Evaluate (Z+0.5)*LOG((Z+1.)/Z) - 1.0 with relative
  5. C accuracy.
  6. C***LIBRARY SLATEC (FNLIB)
  7. C***CATEGORY C7A
  8. C***TYPE COMPLEX (C0LGMC-C)
  9. C***KEYWORDS FNLIB, GAMMA FUNCTION, SPECIAL FUNCTIONS
  10. C***AUTHOR Fullerton, W., (LANL)
  11. C***DESCRIPTION
  12. C
  13. C Evaluate (Z+0.5)*LOG((Z+1.0)/Z) - 1.0 with relative error accuracy
  14. C Let Q = 1.0/Z so that
  15. C (Z+0.5)*LOG(1+1/Z) - 1 = (Z+0.5)*(LOG(1+Q) - Q + Q*Q/2) - Q*Q/4
  16. C = (Z+0.5)*Q**3*C9LN2R(Q) - Q**2/4,
  17. C where C9LN2R is (LOG(1+Q) - Q + 0.5*Q**2) / Q**3.
  18. C
  19. C***REFERENCES (NONE)
  20. C***ROUTINES CALLED C9LN2R, R1MACH
  21. C***REVISION HISTORY (YYMMDD)
  22. C 780401 DATE WRITTEN
  23. C 890531 Changed all specific intrinsics to generic. (WRB)
  24. C 890531 REVISION DATE from Version 3.2
  25. C 891214 Prologue converted to Version 4.0 format. (BAB)
  26. C***END PROLOGUE C0LGMC
  27. COMPLEX Z, Q, C9LN2R
  28. SAVE RBIG
  29. DATA RBIG / 0.0 /
  30. C***FIRST EXECUTABLE STATEMENT C0LGMC
  31. IF (RBIG.EQ.0.0) RBIG = 1.0/R1MACH(3)
  32. C
  33. CABSZ = ABS(Z)
  34. IF (CABSZ.GT.RBIG) C0LGMC = -(Z+0.5)*LOG(Z) - Z
  35. IF (CABSZ.GT.RBIG) RETURN
  36. C
  37. Q = 1.0/Z
  38. IF (CABSZ.LE.1.23) C0LGMC = (Z+0.5)*LOG(1.0+Q) - 1.0
  39. IF (CABSZ.GT.1.23) C0LGMC = ((1.+.5*Q)*C9LN2R(Q) - .25) * Q**2
  40. C
  41. RETURN
  42. END