rmvs2_interp_o.f 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
  1. c*************************************************************************
  2. c RMVS2_INTERP_O.F
  3. c*************************************************************************
  4. c This subroutine interpolates between two kepler orbits.
  5. c For outer region only
  6. c
  7. c Input:
  8. c nbod ==> number of massive bodies
  9. c (int scalar)
  10. c xbeg,ybeg,zbeg ==> initial planet position in helio
  11. c (real arrays)
  12. c vxbeg,vybeg,vzbeg ==> initial planet vel in helio
  13. c (real arrays)
  14. c xend,yend,zend ==> final planet position in helio
  15. c (real arrays)
  16. c vxend,vyend,vzend ==> final planet position in helio
  17. c (real arrays)
  18. c dt ==> time step (real sclar)
  19. c msun ==> mass of sun (real sclar)
  20. c Output:
  21. c xtmpo,ytmpo,ztmpo ==> position of planet wrt time
  22. c for outer region
  23. c (2d real arrays)
  24. c
  25. c
  26. c Remarks:
  27. c Authors: Hal Levison
  28. c Date: 8/26/94
  29. c Last revision:
  30. subroutine rmvs2_interp_o(nbod,xbeg,ybeg,zbeg,vxbeg,vybeg,
  31. & vzbeg,xend,yend,zend,vxend,vyend,vzend,dt,msun,
  32. & xtmpo,ytmpo,ztmpo)
  33. include '../swift.inc'
  34. include '../rmvs/rmvs.inc'
  35. c... Inputs Only:
  36. integer nbod
  37. real*8 dt,msun
  38. real*8 xbeg(NPLMAX),ybeg(NPLMAX),zbeg(NPLMAX)
  39. real*8 vxbeg(NPLMAX),vybeg(NPLMAX),vzbeg(NPLMAX)
  40. real*8 xend(NPLMAX),yend(NPLMAX),zend(NPLMAX)
  41. real*8 vxend(NPLMAX),vyend(NPLMAX),vzend(NPLMAX)
  42. c... Outputs:
  43. real*8 xtmpo(NPLMAX,NTENC),ytmpo(NPLMAX,NTENC)
  44. real*8 ztmpo(NPLMAX,NTENC)
  45. c... Internals
  46. integer i,iflg,ib
  47. real*8 xc2(NPLMAX),yc2(NPLMAX),zc2(NPLMAX)
  48. real*8 vxc2(NPLMAX),vyc2(NPLMAX),vzc2(NPLMAX)
  49. real*8 xc1(NPLMAX),yc1(NPLMAX),zc1(NPLMAX)
  50. real*8 vxc1(NPLMAX),vyc1(NPLMAX),vzc1(NPLMAX)
  51. real*8 dti,dtb,frac,onemf
  52. c----
  53. c... Executable code
  54. dti = dt/float(NTENC)
  55. dtb = -1.0d0*dt
  56. c... move the end positions to beginning
  57. do i=2,nbod
  58. xc1(i) = xbeg(i)
  59. yc1(i) = ybeg(i)
  60. zc1(i) = zbeg(i)
  61. vxc1(i) = vxbeg(i)
  62. vyc1(i) = vybeg(i)
  63. vzc1(i) = vzbeg(i)
  64. xc2(i) = xend(i)
  65. yc2(i) = yend(i)
  66. zc2(i) = zend(i)
  67. vxc2(i) = vxend(i)
  68. vyc2(i) = vyend(i)
  69. vzc2(i) = vzend(i)
  70. call drift_one(msun,xc2(i),yc2(i),zc2(i),
  71. & vxc2(i),vyc2(i),vzc2(i),dtb,iflg)
  72. if(iflg.ne.0) then
  73. write(*,*) ' Planet ',i,' is lost in rmvs2_interp !!!!!!!!!'
  74. write(*,*) msun,dtb
  75. write(*,*) xc2(i),yc2(i),zc2(i)
  76. write(*,*) vxc2(i),vyc2(i),vzc2(i)
  77. write(*,*) ' STOPPING '
  78. call util_exit(1)
  79. endif
  80. enddo
  81. do i=2,nbod
  82. do ib = 1,NTENC
  83. call drift_one(msun,xc1(i),yc1(i),zc1(i),
  84. & vxc1(i),vyc1(i),vzc1(i),dti,iflg)
  85. if(iflg.ne.0) then
  86. write(*,*) ' Planet ',i,' is lost in rmvs2_interp_o !!!'
  87. write(*,*) msun,dtb
  88. write(*,*) xc1(i),yc1(i),zc1(i)
  89. write(*,*) vxc1(i),vyc1(i),vzc1(i)
  90. write(*,*) ' STOPPING '
  91. call util_exit(1)
  92. endif
  93. call drift_one(msun,xc2(i),yc2(i),zc2(i),
  94. & vxc2(i),vyc2(i),vzc2(i),dti,iflg)
  95. if(iflg.ne.0) then
  96. write(*,*) ' Planet ',i,' is lost in rmvs2_interp_o !!!'
  97. write(*,*) msun,dtb
  98. write(*,*) xc2(i),yc2(i),zc2(i)
  99. write(*,*) vxc2(i),vyc2(i),vzc2(i)
  100. write(*,*) ' STOPPING '
  101. call util_exit(1)
  102. endif
  103. frac = float(ib)/float(NTENC)
  104. onemf = 1.0d0 - frac
  105. xtmpo(i,ib) = onemf*xc1(i) + frac*xc2(i)
  106. ytmpo(i,ib) = onemf*yc1(i) + frac*yc2(i)
  107. ztmpo(i,ib) = onemf*zc1(i) + frac*zc2(i)
  108. enddo
  109. enddo
  110. c... put zeros in position 1
  111. do ib = 1,NTENC
  112. xtmpo(1,ib) = 0.0d0
  113. ytmpo(1,ib) = 0.0d0
  114. ztmpo(1,ib) = 0.0d0
  115. enddo
  116. return
  117. end ! rmvs2_interp_o.f
  118. c-----------------------------------------------------------------------