drift_kepu_p3solve.f 1.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172
  1. c*************************************************************************
  2. c DRIFT_KEPU_P3SOLVE.F
  3. c*************************************************************************
  4. c Returns the real root of cubic often found in solving kepler
  5. c problem in universal variables.
  6. c
  7. c Input:
  8. c dt ==> time step (real scalar)
  9. c r0 ==> Distance between `Sun' and paritcle
  10. c (real scalar)
  11. c mu ==> Reduced mass of system (real scalar)
  12. c alpha ==> Twice the binding energy (real scalar)
  13. c u ==> Vel. dot radial vector (real scalar)
  14. c Output:
  15. c s ==> solution of cubic eqn for the
  16. c universal variable
  17. c iflg ==> success flag ( = 0 if O.K.) (integer)
  18. c
  19. c Author: Martin Duncan
  20. c Date: March 12/93
  21. c Last revision: March 12/93
  22. subroutine drift_kepu_p3solve(dt,r0,mu,alpha,u,s,iflg)
  23. c... Inputs:
  24. real*8 dt,r0,mu,alpha,u
  25. c... Outputs:
  26. integer iflg
  27. real*8 s
  28. c... Internals:
  29. real*8 denom,a0,a1,a2,q,r,sq2,sq,p1,p2
  30. c----
  31. c... Executable code
  32. denom = (mu - alpha*r0)/6.d0
  33. a2 = 0.5*u/denom
  34. a1 = r0/denom
  35. a0 =-dt/denom
  36. q = (a1 - a2*a2/3.d0)/3.d0
  37. r = (a1*a2 -3.d0*a0)/6.d0 - (a2**3)/27.d0
  38. sq2 = q**3 + r**2
  39. if( sq2 .ge. 0.d0) then
  40. sq = sqrt(sq2)
  41. if ((r+sq) .le. 0.d0) then
  42. p1 = -(-(r + sq))**(1.d0/3.d0)
  43. else
  44. p1 = (r + sq)**(1.d0/3.d0)
  45. endif
  46. if ((r-sq) .le. 0.d0) then
  47. p2 = -(-(r - sq))**(1.d0/3.d0)
  48. else
  49. p2 = (r - sq)**(1.d0/3.d0)
  50. endif
  51. iflg = 0
  52. s = p1 + p2 - a2/3.d0
  53. else
  54. iflg = 1
  55. s = 0
  56. endif
  57. return
  58. end ! drift_kepu_p3solve
  59. c-------------------------------------------------------------------