symba5_merge.f 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147
  1. c*************************************************************************
  2. c SYMBA5_MERGE.F
  3. c*************************************************************************
  4. c This subroutine checks to see if there are encounters
  5. c
  6. c Input:
  7. c t ==> current time (real scalar)
  8. c dt ==> time step (real scalar)
  9. c nbod ==> number of massive bodies (int scalar)
  10. c nbodm ==> Location of last massive body(int scalar)
  11. c ip1,ip2 ==> The two bodies to check (int scalar)
  12. c mass ==> mass of bodies (real array)
  13. c xh,yh,zh ==> initial position in helio coord
  14. c (real arrays)
  15. c vxb,vyb,vzb ==> initial velocity in helio coord
  16. c (real arrays)
  17. c ireci ==> current recursion level (int scalar)
  18. c irecl ==> maximum recursion level (int scalar)
  19. c svdotrold ==> old radial velocity test
  20. c = .true. if i,j are receding
  21. c = .false is approaching
  22. c (logical*1 scalar)
  23. c iecnt ==> The number of objects that each planet
  24. c is encountering (int*2 array)
  25. c rpl ==> physical size of a planet.
  26. c (real array)
  27. c mergelst ==> list of mergers (int array)
  28. c mergecnt ==> count of mergers (int array)
  29. c rhill ==> Hill sphere of planet (real Scalar)
  30. c eoff ==> Energy offset (real scalar)
  31. c ielc ==> number of encounters (integer*2 scalar)
  32. c ielst ==> list of ecnounters (2D integer*2 array)
  33. c
  34. c Output: Changed only if a Megrer happens
  35. c mass ==> mass of bodies (real array)
  36. c xh,yh,zh ==> initial position in helio coord
  37. c (real arrays)
  38. c vxb,vyb,vzb ==> initial velocity in helio coord
  39. c (real arrays)
  40. c iecnt ==> The number of objects that each planet
  41. c is encountering (int*2 array)
  42. c rpl ==> physical size of a planet.
  43. c (real array)
  44. c mergelst ==> list of mergers (int array)
  45. c mergecnt ==> count of mergers (int array)
  46. c rhill ==> Hill sphere of planet (real Scalar)
  47. c eoff ==> Energy offset (real scalar)
  48. c ielc ==> number of encounters (integer*2 scalar)
  49. c ielst ==> list of ecnounters (2D integer*2 array)
  50. c
  51. c Remarks:
  52. c Authors: Hal Levison
  53. c Date: 1/2/97
  54. c Last revision: 12/16/09
  55. c
  56. subroutine symba5_merge(t,dt,nbod,nbodm,ip1,ip2,mass,xh,yh,zh,vxb,
  57. & vyb,vzb,ireci,irecl,svdotrold,iecnt,rpl,mergelst,mergecnt,
  58. & rhill,eoff,ielc,ielst)
  59. include '../swift.inc'
  60. include 'symba5.inc'
  61. c... Inputs:
  62. integer nbod,nbodm,ireci,irecl,ip1,ip2
  63. real*8 t,dt
  64. logical*1 svdotrold
  65. c... Inputs and Outputs:
  66. real*8 mass(nbod),xh(nbod),yh(nbod),zh(nbod),eoff
  67. real*8 vxb(nbod),vyb(nbod),vzb(nbod),rpl(nbod),rhill(nbod)
  68. integer*2 iecnt(NTPMAX)
  69. integer mergelst(2,NTPMAX),mergecnt
  70. integer ip1l,ip2l
  71. integer*2 ielst(2,NENMAX),ielc
  72. c... Outputs
  73. c... Internals
  74. integer ialpha
  75. real*8 xr,yr,zr,vxr,vyr,vzr,vdotr,tcross2
  76. real*8 rlim,rlim2,rr2,massc,a,e,peri,dt2
  77. c-----
  78. c... Executable code
  79. xr = xh(ip2) - xh(ip1)
  80. yr = yh(ip2) - yh(ip1)
  81. zr = zh(ip2) - zh(ip1)
  82. rr2 = xr**2 + yr**2 + zr**2
  83. rlim = rpl(ip1)+rpl(ip2)
  84. if(rlim.eq.0.0d0) RETURN ! <====== NOTE !!!!!
  85. rlim2 = rlim*rlim
  86. if(rlim2.ge.rr2) then
  87. ip1l = ip1
  88. ip2l = ip2
  89. call discard_mass_merge5_mtiny(t,nbod,nbodm,ip1l,ip2l,mass,xh,
  90. & yh,zh,vxb,vyb,vzb,rpl,eoff,ielc,ielst,NENMAX)
  91. mergecnt = mergecnt + 1
  92. mergelst(1,mergecnt) = ip1l
  93. mergelst(2,mergecnt) = ip2l
  94. rhill(ip2l) = 0.0d0
  95. call util_hills1(mass(1),mass(ip1l),xh(ip1l),yh(ip1l),
  96. & zh(ip1l),vxb(ip1l),vyb(ip1l),vzb(ip1l),rhill(ip1l))
  97. return ! <=== NOTE !!!!!!!!!
  98. endif
  99. vxr = vxb(ip2) - vxb(ip1)
  100. vyr = vyb(ip2) - vyb(ip1)
  101. vzr = vzb(ip2) - vzb(ip1)
  102. vdotr = xr*vxr + yr*vyr + zr*vzr
  103. if( svdotrold .and. (vdotr.gt.0.0d0)) then
  104. tcross2 = rr2/(vxr**2+vyr**2+vzr**2)
  105. dt2 = dt*dt
  106. if(tcross2.le.dt2) then
  107. massc = mass(ip1) + mass(ip2)
  108. call orbel_xv2aeq(xr,yr,zr,vxr,vyr,vzr,massc,
  109. & ialpha,a,e,peri)
  110. if( peri.lt.rlim) then
  111. ip1l = ip1
  112. ip2l = ip2
  113. call discard_mass_merge5_mtiny(t,nbod,nbodm,ip1l,ip2l,
  114. & mass,xh,yh,zh,vxb,vyb,vzb,rpl,eoff,ielc,ielst,
  115. & NENMAX)
  116. mergecnt = mergecnt + 1
  117. mergelst(1,mergecnt) = ip1l
  118. mergelst(2,mergecnt) = ip2l
  119. rhill(ip2l) = 0.0d0
  120. call util_hills1(mass(1),mass(ip1l),xh(ip1l),yh(ip1l),
  121. & zh(ip1l),vxb(ip1l),vyb(ip1l),vzb(ip1l),rhill(ip1l))
  122. endif
  123. endif
  124. endif
  125. return
  126. end ! symba5_merge
  127. c------------------------------------------------------