├── Kepler47 ├── big.in ├── close.in ├── element.in ├── files.in ├── mercury.inc ├── message.in ├── param.in └── small.in ├── Original ├── close6.for ├── element6.for ├── mercury.inc ├── mercury6_2.for ├── message.in └── swift.inc ├── README.rst ├── SolarSystem ├── big.in ├── close.in ├── element.in ├── files.in ├── mercury.inc ├── message.in ├── param.in └── small.in ├── close6_ras.for ├── element6.for ├── mercury.inc ├── mercury6.man ├── mercury6_ras.for └── swift.inc /Kepler47/big.in: -------------------------------------------------------------------------------- 1 | )O+_06 Big-body initial data (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | style (Cartesian, Asteroidal, Cometary) = Cartesian 5 | epoch (in days) = 0. 6 | )--------------------------------------------------------------------- 7 | STAR2 m=.362 8 | -8.638E-02 1.554E-04 .0 9 | -0.00012694 -0.06822481 0. 10 | 0. 0. 0. 11 | PL1 m=2.985E-05 12 | -.146 -.271 1.338E-03 13 | 3.39059774e-02 -3.26846053e-02 4.97494097e-05 14 | 0. 0. 0. 15 | PL2 m=7.295E-05 16 | -.649 .347 2.843E-08 17 | -0.01169765 -0.03867105 0.00010519 18 | 0. 0. 0. 19 | PL3 m=7.295E-5 20 | -1.575E-02 -.985 1.611E-02 21 | 0.02017844 -0.01371033 0.00018183 22 | 0. 0. 0. 23 | -------------------------------------------------------------------------------- /Kepler47/close.in: -------------------------------------------------------------------------------- 1 | )O+_06 close (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | number of input files = 1 5 | )--------------------------------------------------------------------- 6 | ) List the input files, one per line 7 | ce.out 8 | )--------------------------------------------------------------------- 9 | express time in days or years = years 10 | express time relative to integration start time = yes 11 | )--------------------------------------------------------------------- 12 | ) Which bodies do you want? (List one per line or leave blank for all bodies) 13 | ) 14 | -------------------------------------------------------------------------------- /Kepler47/element.in: -------------------------------------------------------------------------------- 1 | )O+_06 element (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | number of input files = 1 5 | )--------------------------------------------------------------------- 6 | ) List the input files, one per line 7 | xv.out 8 | )--------------------------------------------------------------------- 9 | type of elements (central body, barycentric, Jacobi) = Cen 10 | minimum interval between outputs (days) = 0 11 | express time in days or years = years 12 | express time relative to integration start time = yes 13 | )--------------------------------------------------------------------- 14 | ) Output format? (e.g. a8.4 => semi-major axis with 8 digits & 4 dec. places) 15 | m13e x19e y19e z19e u19e v19e w19e 16 | )--------------------------------------------------------------------- 17 | ) Which bodies do you want? (List one per line or leave blank for all bodies) 18 | ) 19 | -------------------------------------------------------------------------------- /Kepler47/files.in: -------------------------------------------------------------------------------- 1 | big.in 2 | small.in 3 | param.in 4 | xv.out 5 | ce.out 6 | info.out 7 | big.dmp 8 | small.dmp 9 | param.dmp 10 | restart.dmp 11 | -------------------------------------------------------------------------------- /Kepler47/mercury.inc: -------------------------------------------------------------------------------- 1 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | c 3 | c MERCURY.INC (ErikSoft 4 March 2001) 4 | c 5 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | c 7 | c Author: John E. Chambers 8 | c 9 | c Parameters that you may want to alter at some point: 10 | c 11 | c NMAX = maximum number of bodies 12 | c CMAX = maximum number of close-encounter minima monitored simultaneously 13 | c NMESS = maximum number of messages in message.in 14 | c HUGE = an implausibly large number 15 | c NFILES = maximum number of files that can be open at the same time 16 | c 17 | integer NMAX, CMAX, NMESS, NFILES 18 | real*8 HUGE 19 | c 20 | parameter (NMAX = 2000) 21 | parameter (CMAX = 50) 22 | parameter (NMESS = 200) 23 | parameter (HUGE = 9.9d29) 24 | parameter (NFILES = 50) 25 | c 26 | c------------------------------------------------------------------------------ 27 | c 28 | c Constants: 29 | c 30 | c DR = conversion factor from degrees to radians 31 | c K2 = Gaussian gravitational constant squared 32 | c AU = astronomical unit in cm 33 | c MSUN = mass of the Sun in g 34 | c 35 | real*8 PI,TWOPI,PIBY2,DR,K2,AU,MSUN 36 | c 37 | parameter (PI = 3.141592653589793d0) 38 | parameter (TWOPI = PI * 2.d0) 39 | parameter (PIBY2 = PI * .5d0) 40 | parameter (DR = PI / 180.d0) 41 | parameter (K2 = 2.959122082855911d-4) 42 | parameter (AU = 1.4959787e13) 43 | parameter (MSUN = 1.9891e33) 44 | 45 | c RAS additions for binary 46 | 47 | c Is this a binary? (yes=.TRUE. no=.FALSE.) 48 | logical isbinary 49 | parameter (isbinary = .TRUE.) 50 | c Name for the central object ("foo") 51 | character*16 cenname 52 | parameter (cenname="STAR1") 53 | c Do we allow collisions or close encounters between the binary stars? (yes=.TRUE. no=.FALSE.) 54 | logical allowclose 55 | parameter (allowclose = .FALSE.) 56 | -------------------------------------------------------------------------------- /Kepler47/message.in: -------------------------------------------------------------------------------- 1 | 1 6 days 2 | 2 6 years 3 | 3 13 solar masses 4 | 4 3 AU 5 | 5 3 no 6 | 6 3 yes 7 | 7 3 low 8 | 8 6 medium 9 | 9 4 high 10 | 10 0 11 | 11 33 Integration parameters 12 | 12 33 ---------------------- 13 | 13 14 Algorithm: 14 | 14 38 Second-order mixed-variable symplectic 15 | 15 24 Bulirsch-Stoer (general) 16 | 16 37 Bulirsch-Stoer (conservative systems) 17 | 17 16 15th-order RADAU 18 | 18 0 19 | 19 0 20 | 20 0 21 | 21 0 22 | 22 5 Test 23 | 23 48 Hybrid symplectic integrator (mixed coordinates) 24 | 24 44 Hybrid symplectic (close binary coordinates) 25 | 25 43 Hybrid symplectic (wide binary coordinates) 26 | 26 32 Integration start epoch: 27 | 27 32 Integration stop epoch: 28 | 28 32 Output interval: 29 | 29 32 Element origin: 30 | 30 31 Initial timestep: 31 | 31 36 Accuracy parameter: 32 | 32 36 Central mass: 33 | 33 36 J_2: 34 | 34 36 J_4: 35 | 35 36 J_6: 36 | 36 36 Ejection distance: 37 | 37 36 Radius of central body: 38 | 38 29 Number of Big bodies: 39 | 39 29 Number of Small bodies: 40 | 40 37 Output precision: 41 | 41 40 Includes collisions: 42 | 42 40 Includes fragmentation: 43 | 43 0 44 | 44 0 45 | 45 40 Includes relativity: 46 | 46 40 Includes user-defined force routine: 47 | 47 10 barycentre 48 | 48 12 central body 49 | 49 0 50 | 50 0 51 | 51 30 Integration details 52 | 52 30 ------------------- 53 | 53 29 Initial energy: 54 | 54 29 Initial angular momentum: 55 | 55 65 Integrating massive bodies and particles up to the same epoch. 56 | 56 34 Beginning the main integration. 57 | 57 24 Integration complete. 58 | 58 48 Fractional energy change due to integrator: 59 | 59 48 Fractional angular momentum change: 60 | 60 57 Fractional energy change due to collisions/ejections: 61 | 61 57 Fractional angular momentum change: 62 | 62 47 Continuing integration from dump files at 63 | 63 6 Time: 64 | 64 6 Date: 65 | 65 9 dE/E: 66 | 66 9 dL/L: 67 | 67 35 collided with the central body at 68 | 68 12 ejected at 69 | 69 12 was hit by 70 | 70 34 removed due to an encounter with 71 | 71 4 at 72 | 72 26 solar masses AU^2 day^-2 73 | 73 26 solar masses AU^2 day^-1 74 | 74 36 lost mass due to rotational breakup 75 | 75 24 removed due to small a 76 | 76 0 77 | 77 0 78 | 78 0 79 | 79 0 80 | 80 0 81 | 81 8 ERROR: 82 | 82 49 Modify mercury.inc and recompile Mercury. 83 | 83 62 Check the file containing initial data for Big bodies. 84 | 84 64 Check the file containing initial data for Small bodies. 85 | 85 57 Check the file containing integration parameters. 86 | 86 22 Check files.in 87 | 87 27 This file already exists: 88 | 88 34 This file is needed to continue: 89 | 89 30 This filename is duplicated: 90 | 90 40 The total number of bodies exceeds NMAX. 91 | 91 68 Data style on first line must be Cartesian, Asteroidal or Cometary 92 | 92 68 You cannot integrate non-gravitational forces using this algorithm. 93 | 93 64 You cannot integrate a user-defined force using this algorithm. 94 | 94 64 You cannot integrate massive Small bodies using this algorithm. 95 | 95 66 Massive Small bodies must have the same epoch as the Big bodies. 96 | 96 49 Check character implies input file is corrupted. 97 | 97 62 Mass, density, encounter limit must be >= 0 for this object: 98 | 98 46 This integration algorithm is not available: 99 | 99 50 A problem occurred reading the parameter on line 100 | 100 50 A problem occurred reading data for this object: 101 | 101 56 A problem occured reading the epoch for the Big bodies. 102 | 102 67 You cannot use non-zero J2,J4,J6 using the close-binary algorithm. 103 | 103 34 Two objects both have this name: 104 | 104 36 is corrupted at line number: 105 | 105 42 Central-body radius exceeds maximum radius. 106 | 106 68 Maximum/Central radius is large. Output precision will be degraded. 107 | 107 58 Coordinate origin must be Central, Barycentric or Jacobi. 108 | 108 0 109 | 109 0 110 | 110 0 111 | 111 0 112 | 112 0 113 | 113 0 114 | 114 0 115 | 115 0 116 | 116 0 117 | 117 0 118 | 118 0 119 | 119 0 120 | 120 0 121 | 121 10 WARNING: 122 | 122 53 Truncating the name of this object to 8 characters: 123 | 123 30 Main integration is backwards. 124 | 124 26 No Big bodies are present. 125 | 125 28 No Small bodies are present. 126 | 126 50 Stopping integration due to an encounter between 127 | 127 45 Throwing this object into the central body: 128 | 128 42 Setting output threshhold DA to infinity. 129 | 129 42 Setting output threshhold DE to infinity. 130 | 130 42 Setting output threshhold DI to infinity. 131 | 131 43 Increasing the radius of the central body. 132 | 132 56 Total number of current close encounters exceeds CMAX. 133 | 133 0 134 | 134 0 135 | 135 0 136 | 136 0 137 | 137 0 138 | 138 0 139 | 139 0 140 | 140 0 141 | 141 0 142 | 142 0 143 | 143 0 144 | 144 0 145 | 145 0 146 | 146 0 147 | 147 0 148 | 148 0 149 | 149 0 150 | 150 0 151 | 151 67 )O+_05 Integration parameters (WARNING: Do not delete this line!!) 152 | 152 66 )O+_05 Big-body initial data (WARNING: Do not delete this line!!) 153 | 153 68 )O+_05 Small-body initial data (WARNING: Do not delete this line!!) 154 | 154 39 ) Lines beginning with `)' are ignored. 155 | 155 70 )--------------------------------------------------------------------- 156 | 156 43 style (Cartesian, Asteroidal, Cometary) = 157 | 157 20 epoch (in days) = 158 | 158 35 ) Important integration parameters: 159 | 159 48 algorithm (MVS, BS, BS2, RADAU, HYBRID etc) = 160 | 160 21 start time (days) = 161 | 161 20 stop time (days) = 162 | 162 26 output interval (days) = 163 | 163 19 timestep (days) = 164 | 164 22 accuracy parameter = 165 | 165 22 ) Integration options: 166 | 166 44 stop integration after a close encounter = 167 | 167 29 allow collisions to occur = 168 | 168 37 include collisional fragmentation = 169 | 169 33 express time in days or years = 170 | 170 51 express time relative to integration start time = 171 | 171 20 output precision = 172 | 172 24 < Not used at present > 173 | 173 37 include relativity in integration = 174 | 174 30 include user-defined force = 175 | 175 52 ) These parameters do not need to be adjusted often: 176 | 176 26 ejection distance (AU) = 177 | 177 31 radius of central body (AU) = 178 | 178 31 central mass (solar masses) = 179 | 179 14 central J2 = 180 | 180 14 central J4 = 181 | 181 14 central J6 = 182 | 182 24 < Not used at present > 183 | 183 24 < Not used at present > 184 | 184 45 Hybrid integrator changeover (Hill radii) = 185 | 185 42 number of timesteps between data dumps = 186 | 186 48 number of timesteps between periodic effects = 187 | 187 41 origin (Central, Barycentric, Jacobi) = 188 | 188 0 189 | 189 0 190 | 190 0 191 | 191 0 192 | 192 0 193 | 193 0 194 | 194 0 195 | 195 0 196 | 196 0 197 | 197 0 198 | 198 0 199 | 199 0 200 | 200 0 201 | -------------------------------------------------------------------------------- /Kepler47/param.in: -------------------------------------------------------------------------------- 1 | )O+_06 Integration parameters (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | ) Important integration parameters: 5 | )--------------------------------------------------------------------- 6 | algorithm (MVS, BS, BS2, RADAU, HYBRID etc) = RADAU 7 | start time (days)= 0. 8 | stop time (days) = 1.E4 9 | output interval (days) = 100. 10 | timestep (days) = 10. 11 | accuracy parameter=1.d-14 12 | )--------------------------------------------------------------------- 13 | ) Integration options: 14 | )--------------------------------------------------------------------- 15 | stop integration after a close encounter = no 16 | allow collisions to occur = yes 17 | include collisional fragmentation = no 18 | express time in days or years = years 19 | express time relative to integration start time = yes 20 | output precision = high 21 | < not used at present > 22 | include relativity in integration= no 23 | include user-defined force = no 24 | )--------------------------------------------------------------------- 25 | ) These parameters do not need to be adjusted often: 26 | )--------------------------------------------------------------------- 27 | ejection distance (AU)= 1000 28 | radius of central body (AU) = 0.0005 29 | central mass (solar) = 1.043 30 | central J2 = 0 31 | central J4 = 0 32 | central J6 = 0 33 | < not used at present > 34 | < not used at present > 35 | Hybrid integrator changeover (Hill radii) = 3. 36 | number of timesteps between data dumps = 100 37 | number of timesteps between periodic effects = 1 38 | -------------------------------------------------------------------------------- /Kepler47/small.in: -------------------------------------------------------------------------------- 1 | )O+_06 Small-body initial data (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | style (Cartesian, Asteroidal, Cometary) = Ast 5 | )--------------------------------------------------------------------- 6 | -------------------------------------------------------------------------------- /Original/close6.for: -------------------------------------------------------------------------------- 1 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | c 3 | c CLOSE6.FOR (ErikSoft 5 June 2001) 4 | c 5 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | c 7 | c Author: John E. Chambers 8 | c 9 | c Makes output files containing details of close encounters that occurred 10 | c during an integration using Mercury6 or higher. 11 | c 12 | c The user specifies the names of the required objects in the file close.in 13 | c 14 | c------------------------------------------------------------------------------ 15 | c 16 | implicit none 17 | include 'mercury.inc' 18 | c 19 | integer itmp,i,j,k,l,iclo,jclo,precision,lenin 20 | integer nmaster,nopen,nwait,nbig,nsml,nsub,lim(2,100) 21 | integer year,month,timestyle,line_num,lenhead,lmem(NMESS) 22 | integer nchar,algor,allflag,firstflag,ninfile 23 | integer unit(NMAX),master_unit(NMAX) 24 | real*8 time,t0,t1,rmax,rcen,rfac,dclo,mcen,jcen(3) 25 | real*8 mio_c2re, mio_c2fl,fr,theta,phi,fv,vtheta,vphi,gm 26 | real*8 x1(3),x2(3),v1(3),v2(3),m(NMAX) 27 | real*8 a1,a2,e1,e2,i1,i2,p1,p2,n1,n2,l1,l2,q1,q2 28 | logical test 29 | character*250 string,fout,header,infile(50) 30 | character*80 mem(NMESS),cc,c(NMAX) 31 | character*8 master_id(NMAX),id(NMAX) 32 | character*5 fin 33 | character*1 check,style,type,c1 34 | c 35 | c------------------------------------------------------------------------------ 36 | c 37 | allflag = 0 38 | c 39 | c Read in output messages 40 | inquire (file='message.in', exist=test) 41 | if (.not.test) then 42 | write (*,'(/,2a)') ' ERROR: This file is needed to continue: ', 43 | % ' message.in' 44 | stop 45 | end if 46 | open (14, file='message.in', status='old') 47 | 10 continue 48 | read (14,'(i3,1x,i2,1x,a80)',end=20) j,lmem(j),mem(j) 49 | goto 10 50 | 20 close (14) 51 | c 52 | c Open file containing parameters for this programme 53 | inquire (file='close.in', exist=test) 54 | if (test) then 55 | open (10, file='close.in', status='old') 56 | else 57 | call mio_err (6,mem(81),lmem(81),mem(88),lmem(88),' ',1, 58 | % 'close.in',9) 59 | end if 60 | c 61 | c Read number of input files 62 | 30 read (10,'(a250)') string 63 | if (string(1:1).eq.')') goto 30 64 | call mio_spl (250,string,nsub,lim) 65 | read (string(lim(1,nsub):lim(2,nsub)),*) ninfile 66 | c 67 | c Make sure all the input files exist 68 | do j = 1, ninfile 69 | 40 read (10,'(a250)') string 70 | if (string(1:1).eq.')') goto 40 71 | call mio_spl (250,string,nsub,lim) 72 | infile(j)(1:(lim(2,1)-lim(1,1)+1)) = string(lim(1,1):lim(2,1)) 73 | inquire (file=infile(j), exist=test) 74 | if (.not.test) call mio_err (6,mem(81),lmem(81),mem(88), 75 | % lmem(88),' ',1,infile(j),80) 76 | end do 77 | c 78 | c Read parameters used by this programme 79 | timestyle = 1 80 | do j = 1, 2 81 | 50 read (10,'(a250)') string 82 | if (string(1:1).eq.')') goto 50 83 | call mio_spl (250,string,nsub,lim) 84 | c1 = string(lim(1,nsub):lim(2,nsub)) 85 | if (j.eq.1.and.(c1.eq.'d'.or.c1.eq.'D')) timestyle = 0 86 | if (j.eq.2.and.(c1.eq.'y'.or.c1.eq.'Y')) timestyle = timestyle+2 87 | end do 88 | c 89 | c Read in the names of the objects for which orbital elements are required 90 | nopen = 0 91 | nwait = 0 92 | nmaster = 0 93 | call m_formce (timestyle,fout,header,lenhead) 94 | 60 continue 95 | read (10,'(a250)',end=70) string 96 | call mio_spl (250,string,nsub,lim) 97 | if (string(1:1).eq.')'.or.lim(1,1).eq.-1) goto 60 98 | c 99 | c Either open an aei file for this object or put it on the waiting list 100 | nmaster = nmaster + 1 101 | itmp = min(7,lim(2,1)-lim(1,1)) 102 | master_id(nmaster)=' ' 103 | master_id(nmaster)(1:itmp+1) = string(lim(1,1):lim(1,1)+itmp) 104 | if (nopen.lt.NFILES) then 105 | nopen = nopen + 1 106 | master_unit(nmaster) = 10 + nopen 107 | call mio_aei (master_id(nmaster),'.clo',master_unit(nmaster), 108 | % header,lenhead,mem,lmem) 109 | else 110 | nwait = nwait + 1 111 | master_unit(nmaster) = -2 112 | end if 113 | goto 60 114 | c 115 | 70 continue 116 | c If no objects are listed in CLOSE.IN assume that all objects are required 117 | if (nopen.eq.0) allflag = 1 118 | close (10) 119 | c 120 | c------------------------------------------------------------------------------ 121 | c 122 | c LOOP OVER EACH INPUT FILE CONTAINING INTEGRATION DATA 123 | c 124 | 90 continue 125 | firstflag = 0 126 | do i = 1, ninfile 127 | line_num = 0 128 | open (10, file=infile(i), status='old') 129 | c 130 | c Loop over each time slice 131 | 100 continue 132 | line_num = line_num + 1 133 | read (10,'(3a1)',end=900,err=666) check,style,type 134 | line_num = line_num - 1 135 | backspace 10 136 | c 137 | c Check if this is an old style input file 138 | if (ichar(check).eq.12.and.(style.eq.'0'.or.style.eq.'1'.or. 139 | % style.eq.'2'.or.style.eq.'3'.or.style.eq.'4')) then 140 | write (*,'(/,2a)') ' ERROR: This is an old style data file', 141 | % ' Try running m_close5.for instead.' 142 | stop 143 | end if 144 | if (ichar(check).ne.12) goto 666 145 | c 146 | c------------------------------------------------------------------------------ 147 | c 148 | c IF SPECIAL INPUT, READ TIME, PARAMETERS, NAMES, MASSES ETC. 149 | c 150 | if (type.eq.'a') then 151 | line_num = line_num + 1 152 | read (10,'(3x,i2,a62,i1)') algor,cc(1:62),precision 153 | c 154 | c Decompress the time, number of objects, central mass and J components etc. 155 | time = mio_c2fl (cc(1:8)) 156 | if (firstflag.eq.0) then 157 | t0 = time 158 | firstflag = 1 159 | end if 160 | nbig = int(.5d0 + mio_c2re(cc(9:16), 0.d0, 11239424.d0, 3)) 161 | nsml = int(.5d0 + mio_c2re(cc(12:19),0.d0, 11239424.d0, 3)) 162 | mcen = mio_c2fl (cc(15:22)) * K2 163 | jcen(1) = mio_c2fl (cc(23:30)) 164 | jcen(2) = mio_c2fl (cc(31:38)) 165 | jcen(3) = mio_c2fl (cc(39:46)) 166 | rcen = mio_c2fl (cc(47:54)) 167 | rmax = mio_c2fl (cc(55:62)) 168 | rfac = log10 (rmax / rcen) 169 | c 170 | c Read in strings containing compressed data for each object 171 | do j = 1, nbig + nsml 172 | line_num = line_num + 1 173 | read (10,'(a)',err=666) c(j)(1:51) 174 | end do 175 | c 176 | c Create input format list 177 | if (precision.eq.1) nchar = 2 178 | if (precision.eq.2) nchar = 4 179 | if (precision.eq.3) nchar = 7 180 | lenin = 3 + 6 * nchar 181 | fin(1:5) = '(a00)' 182 | write (fin(3:4),'(i2)') lenin 183 | c 184 | c For each object decompress its name, code number, mass, spin and density 185 | do j = 1, nbig + nsml 186 | k = int(.5d0 + mio_c2re(c(j)(1:8),0.d0,11239424.d0,3)) 187 | id(k) = c(j)(4:11) 188 | m(k) = mio_c2fl (c(j)(12:19)) * K2 189 | c 190 | c Find the object on the master list 191 | unit(k) = 0 192 | do l = 1, nmaster 193 | if (id(k).eq.master_id(l)) unit(k) = master_unit(l) 194 | end do 195 | c 196 | c If object is not on the master list, add it to the list now 197 | if (unit(k).eq.0) then 198 | nmaster = nmaster + 1 199 | master_id(nmaster) = id(k) 200 | c 201 | c Either open an aei file for this object or put it on the waiting list 202 | if (allflag.eq.1) then 203 | if (nopen.lt.NFILES) then 204 | nopen = nopen + 1 205 | master_unit(nmaster) = 10 + nopen 206 | call mio_aei (master_id(nmaster),'.clo', 207 | % master_unit(nmaster),header,lenhead,mem,lmem) 208 | else 209 | nwait = nwait + 1 210 | master_unit(nmaster) = -2 211 | end if 212 | else 213 | master_unit(nmaster) = -1 214 | end if 215 | unit(k) = master_unit(nmaster) 216 | end if 217 | end do 218 | c 219 | c------------------------------------------------------------------------------ 220 | c 221 | c IF NORMAL INPUT, READ COMPRESSED DATA ON THE CLOSE ENCOUNTER 222 | c 223 | else if (type.eq.'b') then 224 | line_num = line_num + 1 225 | read (10,'(3x,a70)',err=666) cc(1:70) 226 | c 227 | c Decompress time, distance and orbital variables for each object 228 | time = mio_c2fl (cc(1:8)) 229 | iclo = int(.5d0 + mio_c2re(cc(9:16), 0.d0, 11239424.d0, 3)) 230 | jclo = int(.5d0 + mio_c2re(cc(12:19), 0.d0, 11239424.d0, 3)) 231 | if (iclo.gt.NMAX.or.jclo.gt.NMAX) then 232 | write (*,'(/,2a)') mem(81)(1:lmem(81)), 233 | % mem(90)(1:lmem(90)) 234 | stop 235 | end if 236 | dclo = mio_c2fl (cc(15:22)) 237 | fr = mio_c2re (cc(23:30), 0.d0, rfac, 4) 238 | theta = mio_c2re (cc(27:34), 0.d0, PI, 4) 239 | phi = mio_c2re (cc(31:38), 0.d0, TWOPI, 4) 240 | fv = mio_c2re (cc(35:42), 0.d0, 1.d0, 4) 241 | vtheta = mio_c2re (cc(39:46), 0.d0, PI, 4) 242 | vphi = mio_c2re (cc(43:50), 0.d0, TWOPI, 4) 243 | call mco_ov2x (rcen,rmax,mcen,m(iclo),fr,theta,phi,fv, 244 | % vtheta,vphi,x1(1),x1(2),x1(3),v1(1),v1(2),v1(3)) 245 | c 246 | fr = mio_c2re (cc(47:54), 0.d0, rfac, 4) 247 | theta = mio_c2re (cc(51:58), 0.d0, PI, 4) 248 | phi = mio_c2re (cc(55:62), 0.d0, TWOPI, 4) 249 | fv = mio_c2re (cc(59:66), 0.d0, 1.d0, 4) 250 | vtheta = mio_c2re (cc(63:70), 0.d0, PI, 4) 251 | vphi = mio_c2re (cc(67:74), 0.d0, TWOPI, 4) 252 | call mco_ov2x (rcen,rmax,mcen,m(jclo),fr,theta,phi,fv, 253 | % vtheta,vphi,x2(1),x2(2),x2(3),v2(1),v2(2),v2(3)) 254 | c 255 | c Convert to Keplerian elements 256 | gm = mcen + m(iclo) 257 | call mco_x2el (gm,x1(1),x1(2),x1(3),v1(1),v1(2),v1(3), 258 | % q1,e1,i1,p1,n1,l1) 259 | a1 = q1 / (1.d0 - e1) 260 | gm = mcen + m(jclo) 261 | call mco_x2el (gm,x2(1),x2(2),x2(3),v2(1),v2(2),v2(3), 262 | % q2,e2,i2,p2,n2,l2) 263 | a2 = q2 / (1.d0 - e2) 264 | i1 = i1 / DR 265 | i2 = i2 / DR 266 | c 267 | c Convert time to desired format 268 | if (timestyle.eq.0) t1 = time 269 | if (timestyle.eq.1) call mio_jd_y (time,year,month,t1) 270 | if (timestyle.eq.2) t1 = time - t0 271 | if (timestyle.eq.3) t1 = (time - t0) / 365.25d0 272 | c 273 | c Write encounter details to appropriate files 274 | if (timestyle.eq.1) then 275 | if (unit(iclo).ge.10) write (unit(iclo),fout) year,month, 276 | % t1,id(jclo),dclo,a1,e1,i1,a2,e2,i2 277 | c 278 | if (unit(jclo).ge.10) write (unit(jclo),fout) year,month, 279 | % t1,id(iclo),dclo,a2,e2,i2,a1,e1,i1 280 | else 281 | if (unit(iclo).ge.10) write (unit(iclo),fout) t1,id(jclo), 282 | % dclo,a1,e1,i1,a2,e2,i2 283 | if (unit(jclo).ge.10) write (unit(jclo),fout) t1,id(iclo), 284 | % dclo,a2,e2,i2,a1,e1,i1 285 | end if 286 | c 287 | c------------------------------------------------------------------------------ 288 | c 289 | c IF TYPE IS NOT 'a' OR 'b', THE INPUT FILE IS CORRUPTED 290 | c 291 | else 292 | goto 666 293 | end if 294 | c 295 | c Move on to the next time slice 296 | goto 100 297 | c 298 | c If input file is corrupted, try to continue from next uncorrupted time slice 299 | 666 continue 300 | write (*,'(2a,/,a,i10)') mem(121)(1:lmem(121)), 301 | % infile(i)(1:60),mem(104)(1:lmem(104)),line_num 302 | c1 = ' ' 303 | do while (ichar(c1).ne.12) 304 | line_num = line_num + 1 305 | read (10,'(a1)',end=900) c1 306 | end do 307 | line_num = line_num - 1 308 | backspace 10 309 | c 310 | c Move on to the next file containing close encounter data 311 | 900 continue 312 | close (10) 313 | end do 314 | c 315 | c Close clo files 316 | do j = 1, nopen 317 | close (10+j) 318 | end do 319 | nopen = 0 320 | c 321 | c If some objects remain on waiting list, read through input files again 322 | if (nwait.gt.0) then 323 | do j = 1, nmaster 324 | if (master_unit(j).ge.10) master_unit(j) = -1 325 | if (master_unit(j).eq.-2.and.nopen.lt.NFILES) then 326 | nopen = nopen + 1 327 | nwait = nwait - 1 328 | master_unit(j) = 10 + nopen 329 | call mio_aei (master_id(j),'.clo',master_unit(j),header, 330 | % lenhead,mem,lmem) 331 | end if 332 | end do 333 | goto 90 334 | end if 335 | c 336 | end 337 | c 338 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 339 | c 340 | c M_FORMCE.FOR (ErikSoft 30 November 1999) 341 | c 342 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 343 | c 344 | c Author: John E. Chambers 345 | c 346 | c 347 | c------------------------------------------------------------------------------ 348 | c 349 | subroutine m_formce (timestyle,fout,header,lenhead) 350 | c 351 | implicit none 352 | c 353 | c Input/Output 354 | integer timestyle,lenhead 355 | character*250 fout,header 356 | c 357 | c------------------------------------------------------------------------------ 358 | c 359 | if (timestyle.eq.0.or.timestyle.eq.2) then 360 | header(1:19) = ' Time (days) ' 361 | header(20:58) = ' Object dmin (AU) a1 e1 ' 362 | header(59:90) = ' i1 a2 e2 i2' 363 | lenhead = 90 364 | fout = '(1x,f18.5,1x,a8,1x,f10.8,2(1x,f9.4,1x,f8.6,1x,f7.3))' 365 | else 366 | if (timestyle.eq.1) then 367 | header(1:23) = ' Year/Month/Day ' 368 | header(24:62) = ' Object dmin (AU) a1 e1 ' 369 | header(63:94) = ' i1 a2 e2 i2' 370 | lenhead = 94 371 | fout(1:37) = '(1x,i10,1x,i2,1x,f8.5,1x,a8,1x,f10.8,' 372 | fout(38:64) = '2(1x,f9.4,1x,f8.6,1x,f7.3))' 373 | else 374 | header(1:19) = ' Time (years) ' 375 | header(20:58) = ' Object dmin (AU) a1 e1 ' 376 | header(59:90) = ' i1 a2 e2 i2' 377 | fout = '(1x,f18.7,1x,a8,1x,f10.8,2(1x,f9.4,1x,f8.6,1x,f7.3))' 378 | lenhead = 90 379 | end if 380 | end if 381 | c 382 | c------------------------------------------------------------------------------ 383 | c 384 | return 385 | end 386 | c 387 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 388 | c 389 | c MCO_OV2X.FOR (ErikSoft 28 February 2001) 390 | c 391 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 392 | c 393 | c Author: John E. Chambers 394 | c 395 | c Converts output variables for an object to coordinates and velocities. 396 | c The output variables are: 397 | c r = the radial distance 398 | c theta = polar angle 399 | c phi = azimuthal angle 400 | c fv = 1 / [1 + 2(ke/be)^2], where be and ke are the object's binding and 401 | c kinetic energies. (Note that 0 < fv < 1). 402 | c vtheta = polar angle of velocity vector 403 | c vphi = azimuthal angle of the velocity vector 404 | c 405 | c------------------------------------------------------------------------------ 406 | c 407 | subroutine mco_ov2x (rcen,rmax,mcen,m,fr,theta,phi,fv,vtheta, 408 | % vphi,x,y,z,u,v,w) 409 | c 410 | implicit none 411 | include 'mercury.inc' 412 | c 413 | c Input/Output 414 | real*8 rcen,rmax,mcen,m,x,y,z,u,v,w,fr,theta,phi,fv,vtheta,vphi 415 | c 416 | c Local 417 | real*8 r,v1,temp 418 | c 419 | c------------------------------------------------------------------------------ 420 | c 421 | r = rcen * 10.d0**fr 422 | temp = sqrt(.5d0*(1.d0/fv - 1.d0)) 423 | v1 = sqrt(2.d0 * temp * (mcen + m) / r) 424 | c 425 | x = r * sin(theta) * cos(phi) 426 | y = r * sin(theta) * sin(phi) 427 | z = r * cos(theta) 428 | u = v1 * sin(vtheta) * cos(vphi) 429 | v = v1 * sin(vtheta) * sin(vphi) 430 | w = v1 * cos(vtheta) 431 | c 432 | c------------------------------------------------------------------------------ 433 | c 434 | return 435 | end 436 | c 437 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 438 | c 439 | c MCO_EL2X.FOR (ErikSoft 7 July 1999) 440 | c 441 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 442 | c 443 | c Author: John E. Chambers 444 | c 445 | c Calculates Cartesian coordinates and velocities given Keplerian orbital 446 | c elements (for elliptical, parabolic or hyperbolic orbits). 447 | c 448 | c Based on a routine from Levison and Duncan's SWIFT integrator. 449 | c 450 | c mu = grav const * (central + secondary mass) 451 | c q = perihelion distance 452 | c e = eccentricity 453 | c i = inclination ) 454 | c p = longitude of perihelion !!! ) in 455 | c n = longitude of ascending node ) radians 456 | c l = mean anomaly ) 457 | c 458 | c x,y,z = Cartesian positions ( units the same as a ) 459 | c u,v,w = " velocities ( units the same as sqrt(mu/a) ) 460 | c 461 | c------------------------------------------------------------------------------ 462 | c 463 | subroutine mco_el2x (mu,q,e,i,p,n,l,x,y,z,u,v,w) 464 | c 465 | implicit none 466 | include 'mercury.inc' 467 | c 468 | c Input/Output 469 | real*8 mu,q,e,i,p,n,l,x,y,z,u,v,w 470 | c 471 | c Local 472 | real*8 g,a,ci,si,cn,sn,cg,sg,ce,se,romes,temp 473 | real*8 z1,z2,z3,z4,d11,d12,d13,d21,d22,d23 474 | real*8 mco_kep, orbel_fhybrid, orbel_zget 475 | c 476 | c------------------------------------------------------------------------------ 477 | c 478 | c Change from longitude of perihelion to argument of perihelion 479 | g = p - n 480 | c 481 | c Rotation factors 482 | call mco_sine (i,si,ci) 483 | call mco_sine (g,sg,cg) 484 | call mco_sine (n,sn,cn) 485 | z1 = cg * cn 486 | z2 = cg * sn 487 | z3 = sg * cn 488 | z4 = sg * sn 489 | d11 = z1 - z4*ci 490 | d12 = z2 + z3*ci 491 | d13 = sg * si 492 | d21 = -z3 - z2*ci 493 | d22 = -z4 + z1*ci 494 | d23 = cg * si 495 | c 496 | c Semi-major axis 497 | a = q / (1.d0 - e) 498 | c 499 | c Ellipse 500 | if (e.lt.1.d0) then 501 | romes = sqrt(1.d0 - e*e) 502 | temp = mco_kep (e,l) 503 | call mco_sine (temp,se,ce) 504 | z1 = a * (ce - e) 505 | z2 = a * romes * se 506 | temp = sqrt(mu/a) / (1.d0 - e*ce) 507 | z3 = -se * temp 508 | z4 = romes * ce * temp 509 | else 510 | c Parabola 511 | if (e.eq.1.d0) then 512 | ce = orbel_zget(l) 513 | z1 = q * (1.d0 - ce*ce) 514 | z2 = 2.d0 * q * ce 515 | z4 = sqrt(2.d0*mu/q) / (1.d0 + ce*ce) 516 | z3 = -ce * z4 517 | else 518 | c Hyperbola 519 | romes = sqrt(e*e - 1.d0) 520 | temp = orbel_fhybrid(e,l) 521 | call mco_sinh (temp,se,ce) 522 | z1 = a * (ce - e) 523 | z2 = -a * romes * se 524 | temp = sqrt(mu/abs(a)) / (e*ce - 1.d0) 525 | z3 = -se * temp 526 | z4 = romes * ce * temp 527 | end if 528 | endif 529 | c 530 | x = d11*z1 + d21*z2 531 | y = d12*z1 + d22*z2 532 | z = d13*z1 + d23*z2 533 | u = d11*z3 + d21*z4 534 | v = d12*z3 + d22*z4 535 | w = d13*z3 + d23*z4 536 | c 537 | c------------------------------------------------------------------------------ 538 | c 539 | return 540 | end 541 | c 542 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 543 | c 544 | c MCO_KEP.FOR (ErikSoft 7 July 1999) 545 | c 546 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 547 | c 548 | c Author: John E. Chambers 549 | c 550 | c Solves Kepler's equation for eccentricities less than one. 551 | c Algorithm from A. Nijenhuis (1991) Cel. Mech. Dyn. Astron. 51, 319-330. 552 | c 553 | c e = eccentricity 554 | c l = mean anomaly (radians) 555 | c u = eccentric anomaly ( " ) 556 | c 557 | c------------------------------------------------------------------------------ 558 | c 559 | function mco_kep (e,oldl) 560 | implicit none 561 | c 562 | c Input/Outout 563 | real*8 oldl,e,mco_kep 564 | c 565 | c Local 566 | real*8 l,pi,twopi,piby2,u1,u2,ome,sign 567 | real*8 x,x2,sn,dsn,z1,z2,z3,f0,f1,f2,f3 568 | real*8 p,q,p2,ss,cc 569 | logical flag,big,bigg 570 | c 571 | c------------------------------------------------------------------------------ 572 | c 573 | pi = 3.141592653589793d0 574 | twopi = 2.d0 * pi 575 | piby2 = .5d0 * pi 576 | c 577 | c Reduce mean anomaly to lie in the range 0 < l < pi 578 | if (oldl.ge.0) then 579 | l = mod(oldl, twopi) 580 | else 581 | l = mod(oldl, twopi) + twopi 582 | end if 583 | sign = 1.d0 584 | if (l.gt.pi) then 585 | l = twopi - l 586 | sign = -1.d0 587 | end if 588 | c 589 | ome = 1.d0 - e 590 | c 591 | if (l.ge..45d0.or.e.lt..55d0) then 592 | c 593 | c Regions A,B or C in Nijenhuis 594 | c ----------------------------- 595 | c 596 | c Rough starting value for eccentric anomaly 597 | if (l.lt.ome) then 598 | u1 = ome 599 | else 600 | if (l.gt.(pi-1.d0-e)) then 601 | u1 = (l+e*pi)/(1.d0+e) 602 | else 603 | u1 = l + e 604 | end if 605 | end if 606 | c 607 | c Improved value using Halley's method 608 | flag = u1.gt.piby2 609 | if (flag) then 610 | x = pi - u1 611 | else 612 | x = u1 613 | end if 614 | x2 = x*x 615 | sn = x*(1.d0 + x2*(-.16605 + x2*.00761) ) 616 | dsn = 1.d0 + x2*(-.49815 + x2*.03805) 617 | if (flag) dsn = -dsn 618 | f2 = e*sn 619 | f0 = u1 - f2 - l 620 | f1 = 1.d0 - e*dsn 621 | u2 = u1 - f0/(f1 - .5d0*f0*f2/f1) 622 | else 623 | c 624 | c Region D in Nijenhuis 625 | c --------------------- 626 | c 627 | c Rough starting value for eccentric anomaly 628 | z1 = 4.d0*e + .5d0 629 | p = ome / z1 630 | q = .5d0 * l / z1 631 | p2 = p*p 632 | z2 = exp( log( dsqrt( p2*p + q*q ) + q )/1.5 ) 633 | u1 = 2.d0*q / ( z2 + p + p2/z2 ) 634 | c 635 | c Improved value using Newton's method 636 | z2 = u1*u1 637 | z3 = z2*z2 638 | u2 = u1 - .075d0*u1*z3 / (ome + z1*z2 + .375d0*z3) 639 | u2 = l + e*u2*( 3.d0 - 4.d0*u2*u2 ) 640 | end if 641 | c 642 | c Accurate value using 3rd-order version of Newton's method 643 | c N.B. Keep cos(u2) rather than sqrt( 1-sin^2(u2) ) to maintain accuracy! 644 | c 645 | c First get accurate values for u2 - sin(u2) and 1 - cos(u2) 646 | bigg = (u2.gt.piby2) 647 | if (bigg) then 648 | z3 = pi - u2 649 | else 650 | z3 = u2 651 | end if 652 | c 653 | big = (z3.gt.(.5d0*piby2)) 654 | if (big) then 655 | x = piby2 - z3 656 | else 657 | x = z3 658 | end if 659 | c 660 | x2 = x*x 661 | ss = 1.d0 662 | cc = 1.d0 663 | c 664 | ss = x*x2/6.*(1. - x2/20.*(1. - x2/42.*(1. - x2/72.*(1. - 665 | % x2/110.*(1. - x2/156.*(1. - x2/210.*(1. - x2/272.))))))) 666 | cc = x2/2.*(1. - x2/12.*(1. - x2/30.*(1. - x2/56.*(1. - 667 | % x2/ 90.*(1. - x2/132.*(1. - x2/182.*(1. - x2/240.*(1. - 668 | % x2/306.)))))))) 669 | c 670 | if (big) then 671 | z1 = cc + z3 - 1.d0 672 | z2 = ss + z3 + 1.d0 - piby2 673 | else 674 | z1 = ss 675 | z2 = cc 676 | end if 677 | c 678 | if (bigg) then 679 | z1 = 2.d0*u2 + z1 - pi 680 | z2 = 2.d0 - z2 681 | end if 682 | c 683 | f0 = l - u2*ome - e*z1 684 | f1 = ome + e*z2 685 | f2 = .5d0*e*(u2-z1) 686 | f3 = e/6.d0*(1.d0-z2) 687 | z1 = f0/f1 688 | z2 = f0/(f2*z1+f1) 689 | mco_kep = sign*( u2 + f0/((f3*z1+f2)*z2+f1) ) 690 | c 691 | c------------------------------------------------------------------------------ 692 | c 693 | return 694 | end 695 | c 696 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 697 | c 698 | c MCO_SINE.FOR (ErikSoft 17 April 1997) 699 | c 700 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 701 | c 702 | c Author: John E. Chambers 703 | c 704 | c Calculates sin and cos of an angle X (in radians). 705 | c 706 | c------------------------------------------------------------------------------ 707 | c 708 | subroutine mco_sine (x,sx,cx) 709 | c 710 | implicit none 711 | c 712 | c Input/Output 713 | real*8 x,sx,cx 714 | c 715 | c Local 716 | real*8 pi,twopi 717 | c 718 | c------------------------------------------------------------------------------ 719 | c 720 | pi = 3.141592653589793d0 721 | twopi = 2.d0 * pi 722 | c 723 | if (x.gt.0) then 724 | x = mod(x,twopi) 725 | else 726 | x = mod(x,twopi) + twopi 727 | end if 728 | c 729 | cx = cos(x) 730 | c 731 | if (x.gt.pi) then 732 | sx = -sqrt(1.d0 - cx*cx) 733 | else 734 | sx = sqrt(1.d0 - cx*cx) 735 | end if 736 | c 737 | c------------------------------------------------------------------------------ 738 | c 739 | return 740 | end 741 | c 742 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 743 | c 744 | c MCO_SINH.FOR (ErikSoft 12 June 1998) 745 | c 746 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 747 | c 748 | c Calculates sinh and cosh of an angle X (in radians) 749 | c 750 | c------------------------------------------------------------------------------ 751 | c 752 | subroutine mco_sinh (x,sx,cx) 753 | c 754 | implicit none 755 | c 756 | c Input/Output 757 | real*8 x,sx,cx 758 | c 759 | c------------------------------------------------------------------------------ 760 | c 761 | sx = sinh(x) 762 | cx = sqrt (1.d0 + sx*sx) 763 | c 764 | c------------------------------------------------------------------------------ 765 | c 766 | return 767 | end 768 | c 769 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 770 | c 771 | c MIO_AEI.FOR (ErikSoft 31 January 2001) 772 | c 773 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 774 | c 775 | c Author: John E. Chambers 776 | c 777 | c Creates a filename and opens a file to store aei information for an object. 778 | c The filename is based on the name of the object. 779 | c 780 | c------------------------------------------------------------------------------ 781 | c 782 | subroutine mio_aei (id,extn,unitnum,header,lenhead,mem,lmem) 783 | c 784 | implicit none 785 | include 'mercury.inc' 786 | c 787 | c Input/Output 788 | integer unitnum,lenhead,lmem(NMESS) 789 | character*4 extn 790 | character*8 id 791 | character*250 header 792 | character*80 mem(NMESS) 793 | c 794 | c Local 795 | integer j,k,itmp,nsub,lim(2,4) 796 | logical test 797 | character*1 bad(5) 798 | character*250 filename 799 | c 800 | c------------------------------------------------------------------------------ 801 | c 802 | data bad/ '*', '/', '.', ':', '&'/ 803 | c 804 | c Create a filename based on the object's name 805 | call mio_spl (8,id,nsub,lim) 806 | itmp = min(7,lim(2,1)-lim(1,1)) 807 | filename(1:itmp+1) = id(1:itmp+1) 808 | filename(itmp+2:itmp+5) = extn 809 | do j = itmp + 6, 250 810 | filename(j:j) = ' ' 811 | end do 812 | c 813 | c Check for inappropriate characters in the filename 814 | do j = 1, itmp + 1 815 | do k = 1, 5 816 | if (filename(j:j).eq.bad(k)) filename(j:j) = '_' 817 | end do 818 | end do 819 | c 820 | c If the file exists already, give a warning and don't overwrite it 821 | inquire (file=filename, exist=test) 822 | if (test) then 823 | write (*,'(/,3a)') mem(121)(1:lmem(121)),mem(87)(1:lmem(87)), 824 | % filename(1:80) 825 | unitnum = -1 826 | else 827 | open (unitnum, file=filename, status='new') 828 | write (unitnum, '(/,30x,a8,//,a)') id,header(1:lenhead) 829 | end if 830 | c 831 | c------------------------------------------------------------------------------ 832 | c 833 | return 834 | end 835 | c 836 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 837 | c 838 | c MIO_C2FL.FOR (ErikSoft 5 June 2001) 839 | c 840 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 841 | c 842 | c CHARACTER*8 ASCII string into a REAL*8 variable. 843 | c 844 | c N.B. X will lie in the range -1.e112 < X < 1.e112 845 | c === 846 | c 847 | c------------------------------------------------------------------------------ 848 | c 849 | function mio_c2fl (c) 850 | c 851 | implicit none 852 | c 853 | c Input/Output 854 | real*8 mio_c2fl 855 | character*8 c 856 | c 857 | c Local 858 | real*8 x,mio_c2re 859 | integer ex 860 | c 861 | c------------------------------------------------------------------------------ 862 | c 863 | x = mio_c2re (c(1:8), 0.d0, 1.d0, 7) 864 | x = x * 2.d0 - 1.d0 865 | ex = mod(ichar(c(8:8)) + 256, 256) - 32 - 112 866 | mio_c2fl = x * (10.d0**dble(ex)) 867 | c 868 | c------------------------------------------------------------------------------ 869 | c 870 | return 871 | end 872 | c 873 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 874 | c 875 | c MIO_C2RE.FOR (ErikSoft 5 June 2001) 876 | c 877 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 878 | c 879 | c Author: John E. Chambers 880 | c 881 | c Converts an ASCII string into a REAL*8 variable X, where XMIN <= X < XMAX, 882 | c using the new format compression: 883 | c 884 | c X is assumed to be made up of NCHAR base-224 digits, each one represented 885 | c by a character in the ASCII string. Each digit is given by the ASCII 886 | c number of the character minus 32. 887 | c The first 32 ASCII characters (CTRL characters) are avoided, because they 888 | c cause problems when using some operating systems. 889 | c 890 | c------------------------------------------------------------------------------ 891 | c 892 | function mio_c2re (c,xmin,xmax,nchar) 893 | c 894 | implicit none 895 | c 896 | c Input/output 897 | integer nchar 898 | real*8 xmin,xmax,mio_c2re 899 | character*8 c 900 | c 901 | c Local 902 | integer j 903 | real*8 y 904 | c 905 | c------------------------------------------------------------------------------ 906 | c 907 | y = 0 908 | do j = nchar, 1, -1 909 | y = (y + dble(mod(ichar(c(j:j)) + 256, 256) - 32)) / 224.d0 910 | end do 911 | c 912 | mio_c2re = xmin + y * (xmax - xmin) 913 | c 914 | c------------------------------------------------------------------------------ 915 | c 916 | return 917 | end 918 | c 919 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 920 | c 921 | c MIO_ERR.FOR (ErikSoft 6 December 1999) 922 | c 923 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 924 | c 925 | c Author: John E. Chambers 926 | c 927 | c Writes out an error message and terminates Mercury. 928 | c 929 | c------------------------------------------------------------------------------ 930 | c 931 | subroutine mio_err (unit,s1,ls1,s2,ls2,s3,ls3,s4,ls4) 932 | c 933 | implicit none 934 | c 935 | c Input/Output 936 | integer unit,ls1,ls2,ls3,ls4 937 | character*80 s1,s2,s3,s4 938 | c 939 | c------------------------------------------------------------------------------ 940 | c 941 | write (*,'(a)') ' ERROR: Programme terminated.' 942 | write (unit,'(/,3a,/,2a)') s1(1:ls1),s2(1:ls2),s3(1:ls3), 943 | % ' ',s4(1:ls4) 944 | stop 945 | c 946 | c------------------------------------------------------------------------------ 947 | c 948 | end 949 | c 950 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 951 | c 952 | c MCO_H2B.FOR (ErikSoft 2 November 2000) 953 | c 954 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 955 | c 956 | c Author: John E. Chambers 957 | c 958 | c Converts coordinates with respect to the central body to barycentric 959 | c coordinates. 960 | c 961 | c------------------------------------------------------------------------------ 962 | c 963 | subroutine mco_h2b (jcen,nbod,nbig,h,m,xh,vh,x,v) 964 | c 965 | implicit none 966 | c 967 | c Input/Output 968 | integer nbod,nbig 969 | real*8 jcen(3),h,m(nbod),xh(3,nbod),vh(3,nbod),x(3,nbod),v(3,nbod) 970 | c 971 | c Local 972 | integer j 973 | real*8 mtot,temp 974 | c 975 | c------------------------------------------------------------------------------ 976 | c 977 | mtot = 0.d0 978 | x(1,1) = 0.d0 979 | x(2,1) = 0.d0 980 | x(3,1) = 0.d0 981 | v(1,1) = 0.d0 982 | v(2,1) = 0.d0 983 | v(3,1) = 0.d0 984 | c 985 | c Calculate coordinates and velocities of the central body 986 | do j = 2, nbod 987 | mtot = mtot + m(j) 988 | x(1,1) = x(1,1) + m(j) * xh(1,j) 989 | x(2,1) = x(2,1) + m(j) * xh(2,j) 990 | x(3,1) = x(3,1) + m(j) * xh(3,j) 991 | v(1,1) = v(1,1) + m(j) * vh(1,j) 992 | v(2,1) = v(2,1) + m(j) * vh(2,j) 993 | v(3,1) = v(3,1) + m(j) * vh(3,j) 994 | enddo 995 | c 996 | temp = -1.d0 / (mtot + m(1)) 997 | x(1,1) = temp * x(1,1) 998 | x(2,1) = temp * x(2,1) 999 | x(3,1) = temp * x(3,1) 1000 | v(1,1) = temp * v(1,1) 1001 | v(2,1) = temp * v(2,1) 1002 | v(3,1) = temp * v(3,1) 1003 | c 1004 | c Calculate the barycentric coordinates and velocities 1005 | do j = 2, nbod 1006 | x(1,j) = xh(1,j) + x(1,1) 1007 | x(2,j) = xh(2,j) + x(2,1) 1008 | x(3,j) = xh(3,j) + x(3,1) 1009 | v(1,j) = vh(1,j) + v(1,1) 1010 | v(2,j) = vh(2,j) + v(2,1) 1011 | v(3,j) = vh(3,j) + v(3,1) 1012 | enddo 1013 | c 1014 | c------------------------------------------------------------------------------ 1015 | c 1016 | return 1017 | end 1018 | c 1019 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1020 | c 1021 | c MCO_H2CB.FOR (ErikSoft 2 November 2000) 1022 | c 1023 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1024 | c 1025 | c Author: John E. Chambers 1026 | c 1027 | c Convert coordinates with respect to the central body to close-binary 1028 | c coordinates. 1029 | c 1030 | c------------------------------------------------------------------------------ 1031 | c 1032 | subroutine mco_h2cb (jcen,nbod,nbig,h,m,xh,vh,x,v) 1033 | c 1034 | implicit none 1035 | c 1036 | c Input/Output 1037 | integer nbod,nbig 1038 | real*8 jcen(3),h,m(nbod),xh(3,nbod),vh(3,nbod),x(3,nbod),v(3,nbod) 1039 | c 1040 | c Local 1041 | integer j 1042 | real*8 msum,mvsum(3),temp,mbin,mbin_1,mtot_1 1043 | c 1044 | c------------------------------------------------------------------------------ 1045 | c 1046 | msum = 0.d0 1047 | mvsum(1) = 0.d0 1048 | mvsum(2) = 0.d0 1049 | mvsum(3) = 0.d0 1050 | mbin = m(1) + m(2) 1051 | mbin_1 = 1.d0 / mbin 1052 | c 1053 | x(1,2) = xh(1,2) 1054 | x(2,2) = xh(2,2) 1055 | x(3,2) = xh(3,2) 1056 | temp = m(1) * mbin_1 1057 | v(1,2) = temp * vh(1,2) 1058 | v(2,2) = temp * vh(2,2) 1059 | v(3,2) = temp * vh(3,2) 1060 | c 1061 | do j = 3, nbod 1062 | msum = msum + m(j) 1063 | mvsum(1) = mvsum(1) + m(j) * vh(1,j) 1064 | mvsum(2) = mvsum(2) + m(j) * vh(2,j) 1065 | mvsum(3) = mvsum(3) + m(j) * vh(3,j) 1066 | end do 1067 | mtot_1 = 1.d0 / (msum + mbin) 1068 | mvsum(1) = mtot_1 * (mvsum(1) + m(2)*vh(1,2)) 1069 | mvsum(2) = mtot_1 * (mvsum(2) + m(2)*vh(2,2)) 1070 | mvsum(3) = mtot_1 * (mvsum(3) + m(2)*vh(3,2)) 1071 | c 1072 | temp = m(2) * mbin_1 1073 | do j = 3, nbod 1074 | x(1,j) = xh(1,j) - temp * xh(1,2) 1075 | x(2,j) = xh(2,j) - temp * xh(2,2) 1076 | x(3,j) = xh(3,j) - temp * xh(3,2) 1077 | v(1,j) = vh(1,j) - mvsum(1) 1078 | v(2,j) = vh(2,j) - mvsum(2) 1079 | v(3,j) = vh(3,j) - mvsum(3) 1080 | end do 1081 | c 1082 | c------------------------------------------------------------------------------ 1083 | c 1084 | return 1085 | end 1086 | c 1087 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1088 | c 1089 | c MCO_H2J.FOR (ErikSoft 2 November 2000) 1090 | c 1091 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1092 | c 1093 | c Author: John E. Chambers 1094 | c 1095 | c Converts coordinates with respect to the central body to Jacobi coordinates. 1096 | c Note that the Jacobi coordinates of all small bodies are assumed to be the 1097 | c same as their coordinates with respect to the central body. 1098 | c 1099 | c------------------------------------------------------------------------------ 1100 | c 1101 | subroutine mco_h2j (jcen,nbod,nbig,h,m,xh,vh,x,v) 1102 | c 1103 | implicit none 1104 | c 1105 | c Input/Output 1106 | integer nbod,nbig 1107 | real*8 jcen(3),h,m(nbig),xh(3,nbig),vh(3,nbig),x(3,nbig),v(3,nbig) 1108 | c 1109 | c Local 1110 | integer j 1111 | real*8 mtot, mx, my, mz, mu, mv, mw, temp 1112 | c 1113 | c------------------------------------------------------------------------------c 1114 | mtot = m(2) 1115 | x(1,2) = xh(1,2) 1116 | x(2,2) = xh(2,2) 1117 | x(3,2) = xh(3,2) 1118 | v(1,2) = vh(1,2) 1119 | v(2,2) = vh(2,2) 1120 | v(3,2) = vh(3,2) 1121 | mx = m(2) * xh(1,2) 1122 | my = m(2) * xh(2,2) 1123 | mz = m(2) * xh(3,2) 1124 | mu = m(2) * vh(1,2) 1125 | mv = m(2) * vh(2,2) 1126 | mw = m(2) * vh(3,2) 1127 | c 1128 | do j = 3, nbig - 1 1129 | temp = 1.d0 / (mtot + m(1)) 1130 | mtot = mtot + m(j) 1131 | x(1,j) = xh(1,j) - temp * mx 1132 | x(2,j) = xh(2,j) - temp * my 1133 | x(3,j) = xh(3,j) - temp * mz 1134 | v(1,j) = vh(1,j) - temp * mu 1135 | v(2,j) = vh(2,j) - temp * mv 1136 | v(3,j) = vh(3,j) - temp * mw 1137 | mx = mx + m(j) * xh(1,j) 1138 | my = my + m(j) * xh(2,j) 1139 | mz = mz + m(j) * xh(3,j) 1140 | mu = mu + m(j) * vh(1,j) 1141 | mv = mv + m(j) * vh(2,j) 1142 | mw = mw + m(j) * vh(3,j) 1143 | enddo 1144 | c 1145 | if (nbig.gt.2) then 1146 | temp = 1.d0 / (mtot + m(1)) 1147 | x(1,nbig) = xh(1,nbig) - temp * mx 1148 | x(2,nbig) = xh(2,nbig) - temp * my 1149 | x(3,nbig) = xh(3,nbig) - temp * mz 1150 | v(1,nbig) = vh(1,nbig) - temp * mu 1151 | v(2,nbig) = vh(2,nbig) - temp * mv 1152 | v(3,nbig) = vh(3,nbig) - temp * mw 1153 | end if 1154 | c 1155 | do j = nbig + 1, nbod 1156 | x(1,j) = xh(1,j) 1157 | x(2,j) = xh(2,j) 1158 | x(3,j) = xh(3,j) 1159 | v(1,j) = vh(1,j) 1160 | v(2,j) = vh(2,j) 1161 | v(3,j) = vh(3,j) 1162 | end do 1163 | c 1164 | c------------------------------------------------------------------------------ 1165 | c 1166 | return 1167 | end 1168 | c 1169 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1170 | c 1171 | c MCO_IDEN.FOR (ErikSoft 2 November 2000) 1172 | c 1173 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1174 | c 1175 | c Author: John E. Chambers 1176 | c 1177 | c Makes a new copy of a set of coordinates. 1178 | c 1179 | c------------------------------------------------------------------------------ 1180 | c 1181 | subroutine mco_iden (jcen,nbod,nbig,h,m,xh,vh,x,v) 1182 | c 1183 | implicit none 1184 | c 1185 | c Input/Output 1186 | integer nbod,nbig 1187 | real*8 jcen(3),h,m(nbod),x(3,nbod),v(3,nbod),xh(3,nbod),vh(3,nbod) 1188 | c 1189 | c Local 1190 | integer j 1191 | c 1192 | c------------------------------------------------------------------------------ 1193 | c 1194 | do j = 1, nbod 1195 | x(1,j) = xh(1,j) 1196 | x(2,j) = xh(2,j) 1197 | x(3,j) = xh(3,j) 1198 | v(1,j) = vh(1,j) 1199 | v(2,j) = vh(2,j) 1200 | v(3,j) = vh(3,j) 1201 | enddo 1202 | c 1203 | c------------------------------------------------------------------------------ 1204 | c 1205 | return 1206 | end 1207 | c 1208 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1209 | c 1210 | c MCO_X2EL.FOR (ErikSoft 20 February 2001) 1211 | c 1212 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1213 | c 1214 | c Author: John E. Chambers 1215 | c 1216 | c Calculates Keplerian orbital elements given relative coordinates and 1217 | c velocities, and GM = G times the sum of the masses. 1218 | c 1219 | c The elements are: q = perihelion distance 1220 | c e = eccentricity 1221 | c i = inclination 1222 | c p = longitude of perihelion (NOT argument of perihelion!!) 1223 | c n = longitude of ascending node 1224 | c l = mean anomaly (or mean longitude if e < 1.e-8) 1225 | c 1226 | c------------------------------------------------------------------------------ 1227 | c 1228 | subroutine mco_x2el (gm,x,y,z,u,v,w,q,e,i,p,n,l) 1229 | c 1230 | implicit none 1231 | include 'mercury.inc' 1232 | c 1233 | c Input/Output 1234 | real*8 gm,q,e,i,p,n,l,x,y,z,u,v,w 1235 | c 1236 | c Local 1237 | real*8 hx,hy,hz,h2,h,v2,r,rv,s,true 1238 | real*8 ci,to,temp,tmp2,bige,f,cf,ce 1239 | c 1240 | c------------------------------------------------------------------------------ 1241 | c 1242 | hx = y * w - z * v 1243 | hy = z * u - x * w 1244 | hz = x * v - y * u 1245 | h2 = hx*hx + hy*hy + hz*hz 1246 | v2 = u * u + v * v + w * w 1247 | rv = x * u + y * v + z * w 1248 | r = sqrt(x*x + y*y + z*z) 1249 | h = sqrt(h2) 1250 | s = h2 / gm 1251 | c 1252 | c Inclination and node 1253 | ci = hz / h 1254 | if (abs(ci).lt.1) then 1255 | i = acos (ci) 1256 | n = atan2 (hx,-hy) 1257 | if (n.lt.0) n = n + TWOPI 1258 | else 1259 | if (ci.gt.0) i = 0.d0 1260 | if (ci.lt.0) i = PI 1261 | n = 0.d0 1262 | end if 1263 | c 1264 | c Eccentricity and perihelion distance 1265 | temp = 1.d0 + s * (v2 / gm - 2.d0 / r) 1266 | if (temp.le.0) then 1267 | e = 0.d0 1268 | else 1269 | e = sqrt (temp) 1270 | end if 1271 | q = s / (1.d0 + e) 1272 | c 1273 | c True longitude 1274 | if (hy.ne.0) then 1275 | to = -hx/hy 1276 | temp = (1.d0 - ci) * to 1277 | tmp2 = to * to 1278 | true = atan2((y*(1.d0+tmp2*ci)-x*temp),(x*(tmp2+ci)-y*temp)) 1279 | else 1280 | true = atan2(y * ci, x) 1281 | end if 1282 | if (ci.lt.0) true = true + PI 1283 | c 1284 | if (e.lt.3.d-8) then 1285 | p = 0.d0 1286 | l = true 1287 | else 1288 | ce = (v2*r - gm) / (e*gm) 1289 | c 1290 | c Mean anomaly for ellipse 1291 | if (e.lt.1) then 1292 | if (abs(ce).gt.1) ce = sign(1.d0,ce) 1293 | bige = acos(ce) 1294 | if (rv.lt.0) bige = TWOPI - bige 1295 | l = bige - e*sin(bige) 1296 | else 1297 | c 1298 | c Mean anomaly for hyperbola 1299 | if (ce.lt.1) ce = 1.d0 1300 | bige = log( ce + sqrt(ce*ce-1.d0) ) 1301 | if (rv.lt.0) bige = - bige 1302 | l = e*sinh(bige) - bige 1303 | end if 1304 | c 1305 | c Longitude of perihelion 1306 | cf = (s - r) / (e*r) 1307 | if (abs(cf).gt.1) cf = sign(1.d0,cf) 1308 | f = acos(cf) 1309 | if (rv.lt.0) f = TWOPI - f 1310 | p = true - f 1311 | p = mod (p + TWOPI + TWOPI, TWOPI) 1312 | end if 1313 | c 1314 | if (l.lt.0.and.e.lt.1) l = l + TWOPI 1315 | if (l.gt.TWOPI.and.e.lt.1) l = mod (l, TWOPI) 1316 | c 1317 | c------------------------------------------------------------------------------ 1318 | c 1319 | return 1320 | end 1321 | c 1322 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1323 | c 1324 | c MIO_JD_Y.FOR (ErikSoft 2 June 1998) 1325 | c 1326 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1327 | c 1328 | c Author: John E. Chambers 1329 | c 1330 | c Converts from Julian day number to Julian/Gregorian Calendar dates, assuming 1331 | c the dates are those used by the English calendar. 1332 | c 1333 | c Algorithm taken from `Practical Astronomy with your calculator' (1988) 1334 | c by Peter Duffett-Smith, 3rd edition, C.U.P. 1335 | c 1336 | c Algorithm for negative Julian day numbers (Julian calendar assumed) by 1337 | c J. E. Chambers. 1338 | c 1339 | c N.B. The output date is with respect to the Julian Calendar on or before 1340 | c === 4th October 1582, and with respect to the Gregorian Calendar on or 1341 | c after 15th October 1582. 1342 | c 1343 | c 1344 | c------------------------------------------------------------------------------ 1345 | c 1346 | subroutine mio_jd_y (jd0,year,month,day) 1347 | c 1348 | implicit none 1349 | c 1350 | c Input/Output 1351 | real*8 jd0,day 1352 | integer year,month 1353 | c 1354 | c Local 1355 | integer i,a,b,c,d,e,g 1356 | real*8 jd,f,temp,x,y,z 1357 | c 1358 | c------------------------------------------------------------------------------ 1359 | c 1360 | if (jd0.le.0) goto 50 1361 | c 1362 | jd = jd0 + 0.5d0 1363 | i = sign( dint(dabs(jd)), jd ) 1364 | f = jd - 1.d0*i 1365 | c 1366 | c If on or after 15th October 1582 1367 | if (i.gt.2299160) then 1368 | temp = (1.d0*i-1867216.25d0) / 36524.25d0 1369 | a = sign( dint(dabs(temp)), temp ) 1370 | temp = .25d0 * a 1371 | b = i + 1 + a - sign( dint(dabs(temp)), temp ) 1372 | else 1373 | b = i 1374 | end if 1375 | c 1376 | c = b + 1524 1377 | temp = (1.d0*c - 122.1d0) / 365.25d0 1378 | d = sign( dint(dabs(temp)), temp ) 1379 | temp = 365.25d0 * d 1380 | e = sign( dint(dabs(temp)), temp ) 1381 | temp = (c-e) / 30.6001d0 1382 | g = sign( dint(dabs(temp)), temp ) 1383 | c 1384 | temp = 30.6001d0 * g 1385 | day = 1.d0*(c-e) + f - 1.d0*sign( dint(dabs(temp)), temp ) 1386 | c 1387 | if (g.le.13) month = g - 1 1388 | if (g.gt.13) month = g - 13 1389 | c 1390 | if (month.gt.2) year = d - 4716 1391 | if (month.le.2) year = d - 4715 1392 | c 1393 | if (day.gt.32) then 1394 | day = day - 32 1395 | month = month + 1 1396 | end if 1397 | c 1398 | if (month.gt.12) then 1399 | month = month - 12 1400 | year = year + 1 1401 | end if 1402 | return 1403 | c 1404 | 50 continue 1405 | c 1406 | c Algorithm for negative Julian day numbers (Duffett-Smith won't work) 1407 | x = jd0 - 2232101.5 1408 | f = x - dint(x) 1409 | if (f.lt.0) f = f + 1.d0 1410 | y = dint(mod(x,1461.d0) + 1461.d0) 1411 | z = dint(mod(y,365.25d0)) 1412 | month = int((z + 0.5d0) / 30.61d0) 1413 | day = dint(z + 1.5d0 - 30.61d0*dble(month)) + f 1414 | month = mod(month + 2, 12) + 1 1415 | c 1416 | year = 1399 + int (x / 365.25d0) 1417 | if (x.lt.0) year = year - 1 1418 | if (month.lt.3) year = year + 1 1419 | c 1420 | c------------------------------------------------------------------------------ 1421 | c 1422 | return 1423 | end 1424 | c 1425 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1426 | c 1427 | c MIO_SPL.FOR (ErikSoft 14 November 1999) 1428 | c 1429 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1430 | c 1431 | c Author: John E. Chambers 1432 | c 1433 | c Given a character string STRING, of length LEN bytes, the routine finds 1434 | c the beginnings and ends of NSUB substrings present in the original, and 1435 | c delimited by spaces. The positions of the extremes of each substring are 1436 | c returned in the array DELIMIT. 1437 | c Substrings are those which are separated by spaces or the = symbol. 1438 | c 1439 | c------------------------------------------------------------------------------ 1440 | c 1441 | subroutine mio_spl (len,string,nsub,delimit) 1442 | c 1443 | implicit none 1444 | c 1445 | c Input/Output 1446 | integer len,nsub,delimit(2,100) 1447 | character*1 string(len) 1448 | c 1449 | c Local 1450 | integer j,k 1451 | character*1 c 1452 | c 1453 | c------------------------------------------------------------------------------ 1454 | c 1455 | nsub = 0 1456 | j = 0 1457 | c = ' ' 1458 | delimit(1,1) = -1 1459 | c 1460 | c Find the start of string 1461 | 10 j = j + 1 1462 | if (j.gt.len) goto 99 1463 | c = string(j) 1464 | if (c.eq.' '.or.c.eq.'=') goto 10 1465 | c 1466 | c Find the end of string 1467 | k = j 1468 | 20 k = k + 1 1469 | if (k.gt.len) goto 30 1470 | c = string(k) 1471 | if (c.ne.' '.and.c.ne.'=') goto 20 1472 | c 1473 | c Store details for this string 1474 | 30 nsub = nsub + 1 1475 | delimit(1,nsub) = j 1476 | delimit(2,nsub) = k - 1 1477 | c 1478 | if (k.lt.len) then 1479 | j = k 1480 | goto 10 1481 | end if 1482 | c 1483 | 99 continue 1484 | c 1485 | c------------------------------------------------------------------------------ 1486 | c 1487 | return 1488 | end 1489 | c 1490 | *********************************************************************** 1491 | c ORBEL_FHYBRID.F 1492 | *********************************************************************** 1493 | * PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. 1494 | * 1495 | * Input: 1496 | * e ==> eccentricity anomaly. (real scalar) 1497 | * n ==> hyperbola mean anomaly. (real scalar) 1498 | * Returns: 1499 | * orbel_fhybrid ==> eccentric anomaly. (real scalar) 1500 | * 1501 | * ALGORITHM: For abs(N) < 0.636*ecc -0.6 , use FLON 1502 | * For larger N, uses FGET 1503 | * REMARKS: 1504 | * AUTHOR: M. Duncan 1505 | * DATE WRITTEN: May 26,1992. 1506 | * REVISIONS: 1507 | * REVISIONS: 2/26/93 hfl 1508 | *********************************************************************** 1509 | 1510 | real*8 function orbel_fhybrid(e,n) 1511 | 1512 | include 'swift.inc' 1513 | 1514 | c... Inputs Only: 1515 | real*8 e,n 1516 | 1517 | c... Internals: 1518 | real*8 abn 1519 | real*8 orbel_flon,orbel_fget 1520 | 1521 | c---- 1522 | c... Executable code 1523 | 1524 | abn = n 1525 | if(n.lt.0.d0) abn = -abn 1526 | 1527 | if(abn .lt. 0.636d0*e -0.6d0) then 1528 | orbel_fhybrid = orbel_flon(e,n) 1529 | else 1530 | orbel_fhybrid = orbel_fget(e,n) 1531 | endif 1532 | 1533 | return 1534 | end ! orbel_fhybrid 1535 | c------------------------------------------------------------------- 1536 | c 1537 | *********************************************************************** 1538 | c ORBEL_FGET.F 1539 | *********************************************************************** 1540 | * PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. 1541 | * 1542 | * Input: 1543 | * e ==> eccentricity anomaly. (real scalar) 1544 | * capn ==> hyperbola mean anomaly. (real scalar) 1545 | * Returns: 1546 | * orbel_fget ==> eccentric anomaly. (real scalar) 1547 | * 1548 | * ALGORITHM: Based on pp. 70-72 of Fitzpatrick's book "Principles of 1549 | * Cel. Mech. ". Quartic convergence from Danby's book. 1550 | * REMARKS: 1551 | * AUTHOR: M. Duncan 1552 | * DATE WRITTEN: May 11, 1992. 1553 | * REVISIONS: 2/26/93 hfl 1554 | c Modified by JEC 1555 | *********************************************************************** 1556 | 1557 | real*8 function orbel_fget(e,capn) 1558 | 1559 | include 'swift.inc' 1560 | 1561 | c... Inputs Only: 1562 | real*8 e,capn 1563 | 1564 | c... Internals: 1565 | integer i,IMAX 1566 | real*8 tmp,x,shx,chx 1567 | real*8 esh,ech,f,fp,fpp,fppp,dx 1568 | PARAMETER (IMAX = 10) 1569 | 1570 | c---- 1571 | c... Executable code 1572 | 1573 | c Function to solve "Kepler's eqn" for F (here called 1574 | c x) for given e and CAPN. 1575 | 1576 | c begin with a guess proposed by Danby 1577 | if( capn .lt. 0.d0) then 1578 | tmp = -2.d0*capn/e + 1.8d0 1579 | x = -log(tmp) 1580 | else 1581 | tmp = +2.d0*capn/e + 1.8d0 1582 | x = log( tmp) 1583 | endif 1584 | 1585 | orbel_fget = x 1586 | 1587 | do i = 1,IMAX 1588 | call mco_sinh (x,shx,chx) 1589 | esh = e*shx 1590 | ech = e*chx 1591 | f = esh - x - capn 1592 | c write(6,*) 'i,x,f : ',i,x,f 1593 | fp = ech - 1.d0 1594 | fpp = esh 1595 | fppp = ech 1596 | dx = -f/fp 1597 | dx = -f/(fp + dx*fpp/2.d0) 1598 | dx = -f/(fp + dx*fpp/2.d0 + dx*dx*fppp/6.d0) 1599 | orbel_fget = x + dx 1600 | c If we have converged here there's no point in going on 1601 | if(abs(dx) .le. TINY) RETURN 1602 | x = orbel_fget 1603 | enddo 1604 | 1605 | write(6,*) 'FGET : RETURNING WITHOUT COMPLETE CONVERGENCE' 1606 | return 1607 | end ! orbel_fget 1608 | c------------------------------------------------------------------ 1609 | c 1610 | *********************************************************************** 1611 | c ORBEL_FLON.F 1612 | *********************************************************************** 1613 | * PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. 1614 | * 1615 | * Input: 1616 | * e ==> eccentricity anomaly. (real scalar) 1617 | * capn ==> hyperbola mean anomaly. (real scalar) 1618 | * Returns: 1619 | * orbel_flon ==> eccentric anomaly. (real scalar) 1620 | * 1621 | * ALGORITHM: Uses power series for N in terms of F and Newton,s method 1622 | * REMARKS: ONLY GOOD FOR LOW VALUES OF N (N < 0.636*e -0.6) 1623 | * AUTHOR: M. Duncan 1624 | * DATE WRITTEN: May 26, 1992. 1625 | * REVISIONS: 1626 | *********************************************************************** 1627 | 1628 | real*8 function orbel_flon(e,capn) 1629 | 1630 | include 'swift.inc' 1631 | 1632 | c... Inputs Only: 1633 | real*8 e,capn 1634 | 1635 | c... Internals: 1636 | integer iflag,i,IMAX 1637 | real*8 a,b,sq,biga,bigb 1638 | real*8 x,x2 1639 | real*8 f,fp,dx 1640 | real*8 diff 1641 | real*8 a0,a1,a3,a5,a7,a9,a11 1642 | real*8 b1,b3,b5,b7,b9,b11 1643 | PARAMETER (IMAX = 10) 1644 | PARAMETER (a11 = 156.d0,a9 = 17160.d0,a7 = 1235520.d0) 1645 | PARAMETER (a5 = 51891840.d0,a3 = 1037836800.d0) 1646 | PARAMETER (b11 = 11.d0*a11,b9 = 9.d0*a9,b7 = 7.d0*a7) 1647 | PARAMETER (b5 = 5.d0*a5, b3 = 3.d0*a3) 1648 | 1649 | c---- 1650 | c... Executable code 1651 | 1652 | 1653 | c Function to solve "Kepler's eqn" for F (here called 1654 | c x) for given e and CAPN. Only good for smallish CAPN 1655 | 1656 | iflag = 0 1657 | if( capn .lt. 0.d0) then 1658 | iflag = 1 1659 | capn = -capn 1660 | endif 1661 | 1662 | a1 = 6227020800.d0 * (1.d0 - 1.d0/e) 1663 | a0 = -6227020800.d0*capn/e 1664 | b1 = a1 1665 | 1666 | c Set iflag nonzero if capn < 0., in which case solve for -capn 1667 | c and change the sign of the final answer for F. 1668 | c Begin with a reasonable guess based on solving the cubic for small F 1669 | 1670 | 1671 | a = 6.d0*(e-1.d0)/e 1672 | b = -6.d0*capn/e 1673 | sq = sqrt(0.25*b*b +a*a*a/27.d0) 1674 | biga = (-0.5*b + sq)**0.3333333333333333d0 1675 | bigb = -(+0.5*b + sq)**0.3333333333333333d0 1676 | x = biga + bigb 1677 | c write(6,*) 'cubic = ',x**3 +a*x +b 1678 | orbel_flon = x 1679 | c If capn is tiny (or zero) no need to go further than cubic even for 1680 | c e =1. 1681 | if( capn .lt. TINY) go to 100 1682 | 1683 | do i = 1,IMAX 1684 | x2 = x*x 1685 | f = a0 +x*(a1+x2*(a3+x2*(a5+x2*(a7+x2*(a9+x2*(a11+x2)))))) 1686 | fp = b1 +x2*(b3+x2*(b5+x2*(b7+x2*(b9+x2*(b11 + 13.d0*x2))))) 1687 | dx = -f/fp 1688 | c write(6,*) 'i,dx,x,f : ' 1689 | c write(6,432) i,dx,x,f 1690 | 432 format(1x,i3,3(2x,1p1e22.15)) 1691 | orbel_flon = x + dx 1692 | c If we have converged here there's no point in going on 1693 | if(abs(dx) .le. TINY) go to 100 1694 | x = orbel_flon 1695 | enddo 1696 | 1697 | c Abnormal return here - we've gone thru the loop 1698 | c IMAX times without convergence 1699 | if(iflag .eq. 1) then 1700 | orbel_flon = -orbel_flon 1701 | capn = -capn 1702 | endif 1703 | write(6,*) 'FLON : RETURNING WITHOUT COMPLETE CONVERGENCE' 1704 | diff = e*sinh(orbel_flon) - orbel_flon - capn 1705 | write(6,*) 'N, F, ecc*sinh(F) - F - N : ' 1706 | write(6,*) capn,orbel_flon,diff 1707 | return 1708 | 1709 | c Normal return here, but check if capn was originally negative 1710 | 100 if(iflag .eq. 1) then 1711 | orbel_flon = -orbel_flon 1712 | capn = -capn 1713 | endif 1714 | 1715 | return 1716 | end ! orbel_flon 1717 | c------------------------------------------------------------------ 1718 | c 1719 | *********************************************************************** 1720 | c ORBEL_ZGET.F 1721 | *********************************************************************** 1722 | * PURPOSE: Solves the equivalent of Kepler's eqn. for a parabola 1723 | * given Q (Fitz. notation.) 1724 | * 1725 | * Input: 1726 | * q ==> parabola mean anomaly. (real scalar) 1727 | * Returns: 1728 | * orbel_zget ==> eccentric anomaly. (real scalar) 1729 | * 1730 | * ALGORITHM: p. 70-72 of Fitzpatrick's book "Princ. of Cel. Mech." 1731 | * REMARKS: For a parabola we can solve analytically. 1732 | * AUTHOR: M. Duncan 1733 | * DATE WRITTEN: May 11, 1992. 1734 | * REVISIONS: May 27 - corrected it for negative Q and use power 1735 | * series for small Q. 1736 | *********************************************************************** 1737 | 1738 | real*8 function orbel_zget(q) 1739 | 1740 | include 'swift.inc' 1741 | 1742 | c... Inputs Only: 1743 | real*8 q 1744 | 1745 | c... Internals: 1746 | integer iflag 1747 | real*8 x,tmp 1748 | 1749 | c---- 1750 | c... Executable code 1751 | 1752 | iflag = 0 1753 | if(q.lt.0.d0) then 1754 | iflag = 1 1755 | q = -q 1756 | endif 1757 | 1758 | if (q.lt.1.d-3) then 1759 | orbel_zget = q*(1.d0 - (q*q/3.d0)*(1.d0 -q*q)) 1760 | else 1761 | x = 0.5d0*(3.d0*q + sqrt(9.d0*(q**2) +4.d0)) 1762 | tmp = x**(1.d0/3.d0) 1763 | orbel_zget = tmp - 1.d0/tmp 1764 | endif 1765 | 1766 | if(iflag .eq.1) then 1767 | orbel_zget = -orbel_zget 1768 | q = -q 1769 | endif 1770 | 1771 | return 1772 | end ! orbel_zget 1773 | c---------------------------------------------------------------------- 1774 | 1775 | 1776 | -------------------------------------------------------------------------------- /Original/mercury.inc: -------------------------------------------------------------------------------- 1 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | c 3 | c MERCURY.INC (ErikSoft 4 March 2001) 4 | c 5 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | c 7 | c Author: John E. Chambers 8 | c 9 | c Parameters that you may want to alter at some point: 10 | c 11 | c NMAX = maximum number of bodies 12 | c CMAX = maximum number of close-encounter minima monitored simultaneously 13 | c NMESS = maximum number of messages in message.in 14 | c HUGE = an implausibly large number 15 | c NFILES = maximum number of files that can be open at the same time 16 | c 17 | integer NMAX, CMAX, NMESS, NFILES 18 | real*8 HUGE 19 | c 20 | parameter (NMAX = 2000) 21 | parameter (CMAX = 50) 22 | parameter (NMESS = 200) 23 | parameter (HUGE = 9.9d29) 24 | parameter (NFILES = 50) 25 | c 26 | c------------------------------------------------------------------------------ 27 | c 28 | c Constants: 29 | c 30 | c DR = conversion factor from degrees to radians 31 | c K2 = Gaussian gravitational constant squared 32 | c AU = astronomical unit in cm 33 | c MSUN = mass of the Sun in g 34 | c 35 | real*8 PI,TWOPI,PIBY2,DR,K2,AU,MSUN 36 | c 37 | parameter (PI = 3.141592653589793d0) 38 | parameter (TWOPI = PI * 2.d0) 39 | parameter (PIBY2 = PI * .5d0) 40 | parameter (DR = PI / 180.d0) 41 | parameter (K2 = 2.959122082855911d-4) 42 | parameter (AU = 1.4959787e13) 43 | parameter (MSUN = 1.9891e33) 44 | 45 | logical isbinary 46 | c RAS IS BINARY 47 | parameter (isbinary = .TRUE.) 48 | -------------------------------------------------------------------------------- /Original/message.in: -------------------------------------------------------------------------------- 1 | 1 6 days 2 | 2 6 years 3 | 3 13 solar masses 4 | 4 3 AU 5 | 5 3 no 6 | 6 3 yes 7 | 7 3 low 8 | 8 6 medium 9 | 9 4 high 10 | 10 0 11 | 11 33 Integration parameters 12 | 12 33 ---------------------- 13 | 13 14 Algorithm: 14 | 14 38 Second-order mixed-variable symplectic 15 | 15 24 Bulirsch-Stoer (general) 16 | 16 37 Bulirsch-Stoer (conservative systems) 17 | 17 16 15th-order RADAU 18 | 18 0 19 | 19 0 20 | 20 0 21 | 21 0 22 | 22 5 Test 23 | 23 48 Hybrid symplectic integrator (mixed coordinates) 24 | 24 44 Hybrid symplectic (close binary coordinates) 25 | 25 43 Hybrid symplectic (wide binary coordinates) 26 | 26 32 Integration start epoch: 27 | 27 32 Integration stop epoch: 28 | 28 32 Output interval: 29 | 29 32 Element origin: 30 | 30 31 Initial timestep: 31 | 31 36 Accuracy parameter: 32 | 32 36 Central mass: 33 | 33 36 J_2: 34 | 34 36 J_4: 35 | 35 36 J_6: 36 | 36 36 Ejection distance: 37 | 37 36 Radius of central body: 38 | 38 29 Number of Big bodies: 39 | 39 29 Number of Small bodies: 40 | 40 37 Output precision: 41 | 41 40 Includes collisions: 42 | 42 40 Includes fragmentation: 43 | 43 0 44 | 44 0 45 | 45 40 Includes relativity: 46 | 46 40 Includes user-defined force routine: 47 | 47 10 barycentre 48 | 48 12 central body 49 | 49 0 50 | 50 0 51 | 51 30 Integration details 52 | 52 30 ------------------- 53 | 53 29 Initial energy: 54 | 54 29 Initial angular momentum: 55 | 55 65 Integrating massive bodies and particles up to the same epoch. 56 | 56 34 Beginning the main integration. 57 | 57 24 Integration complete. 58 | 58 48 Fractional energy change due to integrator: 59 | 59 48 Fractional angular momentum change: 60 | 60 57 Fractional energy change due to collisions/ejections: 61 | 61 57 Fractional angular momentum change: 62 | 62 47 Continuing integration from dump files at 63 | 63 6 Time: 64 | 64 6 Date: 65 | 65 9 dE/E: 66 | 66 9 dL/L: 67 | 67 35 collided with the central body at 68 | 68 12 ejected at 69 | 69 12 was hit by 70 | 70 34 removed due to an encounter with 71 | 71 4 at 72 | 72 26 solar masses AU^2 day^-2 73 | 73 26 solar masses AU^2 day^-1 74 | 74 36 lost mass due to rotational breakup 75 | 75 24 removed due to small a 76 | 76 0 77 | 77 0 78 | 78 0 79 | 79 0 80 | 80 0 81 | 81 8 ERROR: 82 | 82 49 Modify mercury.inc and recompile Mercury. 83 | 83 62 Check the file containing initial data for Big bodies. 84 | 84 64 Check the file containing initial data for Small bodies. 85 | 85 57 Check the file containing integration parameters. 86 | 86 22 Check files.in 87 | 87 27 This file already exists: 88 | 88 34 This file is needed to continue: 89 | 89 30 This filename is duplicated: 90 | 90 40 The total number of bodies exceeds NMAX. 91 | 91 68 Data style on first line must be Cartesian, Asteroidal or Cometary 92 | 92 68 You cannot integrate non-gravitational forces using this algorithm. 93 | 93 64 You cannot integrate a user-defined force using this algorithm. 94 | 94 64 You cannot integrate massive Small bodies using this algorithm. 95 | 95 66 Massive Small bodies must have the same epoch as the Big bodies. 96 | 96 49 Check character implies input file is corrupted. 97 | 97 62 Mass, density, encounter limit must be >= 0 for this object: 98 | 98 46 This integration algorithm is not available: 99 | 99 50 A problem occurred reading the parameter on line 100 | 100 50 A problem occurred reading data for this object: 101 | 101 56 A problem occured reading the epoch for the Big bodies. 102 | 102 67 You cannot use non-zero J2,J4,J6 using the close-binary algorithm. 103 | 103 34 Two objects both have this name: 104 | 104 36 is corrupted at line number: 105 | 105 42 Central-body radius exceeds maximum radius. 106 | 106 68 Maximum/Central radius is large. Output precision will be degraded. 107 | 107 58 Coordinate origin must be Central, Barycentric or Jacobi. 108 | 108 0 109 | 109 0 110 | 110 0 111 | 111 0 112 | 112 0 113 | 113 0 114 | 114 0 115 | 115 0 116 | 116 0 117 | 117 0 118 | 118 0 119 | 119 0 120 | 120 0 121 | 121 10 WARNING: 122 | 122 53 Truncating the name of this object to 8 characters: 123 | 123 30 Main integration is backwards. 124 | 124 26 No Big bodies are present. 125 | 125 28 No Small bodies are present. 126 | 126 50 Stopping integration due to an encounter between 127 | 127 45 Throwing this object into the central body: 128 | 128 42 Setting output threshhold DA to infinity. 129 | 129 42 Setting output threshhold DE to infinity. 130 | 130 42 Setting output threshhold DI to infinity. 131 | 131 43 Increasing the radius of the central body. 132 | 132 56 Total number of current close encounters exceeds CMAX. 133 | 133 0 134 | 134 0 135 | 135 0 136 | 136 0 137 | 137 0 138 | 138 0 139 | 139 0 140 | 140 0 141 | 141 0 142 | 142 0 143 | 143 0 144 | 144 0 145 | 145 0 146 | 146 0 147 | 147 0 148 | 148 0 149 | 149 0 150 | 150 0 151 | 151 67 )O+_05 Integration parameters (WARNING: Do not delete this line!!) 152 | 152 66 )O+_05 Big-body initial data (WARNING: Do not delete this line!!) 153 | 153 68 )O+_05 Small-body initial data (WARNING: Do not delete this line!!) 154 | 154 39 ) Lines beginning with `)' are ignored. 155 | 155 70 )--------------------------------------------------------------------- 156 | 156 43 style (Cartesian, Asteroidal, Cometary) = 157 | 157 20 epoch (in days) = 158 | 158 35 ) Important integration parameters: 159 | 159 48 algorithm (MVS, BS, BS2, RADAU, HYBRID etc) = 160 | 160 21 start time (days) = 161 | 161 20 stop time (days) = 162 | 162 26 output interval (days) = 163 | 163 19 timestep (days) = 164 | 164 22 accuracy parameter = 165 | 165 22 ) Integration options: 166 | 166 44 stop integration after a close encounter = 167 | 167 29 allow collisions to occur = 168 | 168 37 include collisional fragmentation = 169 | 169 33 express time in days or years = 170 | 170 51 express time relative to integration start time = 171 | 171 20 output precision = 172 | 172 24 < Not used at present > 173 | 173 37 include relativity in integration = 174 | 174 30 include user-defined force = 175 | 175 52 ) These parameters do not need to be adjusted often: 176 | 176 26 ejection distance (AU) = 177 | 177 31 radius of central body (AU) = 178 | 178 31 central mass (solar masses) = 179 | 179 14 central J2 = 180 | 180 14 central J4 = 181 | 181 14 central J6 = 182 | 182 24 < Not used at present > 183 | 183 24 < Not used at present > 184 | 184 45 Hybrid integrator changeover (Hill radii) = 185 | 185 42 number of timesteps between data dumps = 186 | 186 48 number of timesteps between periodic effects = 187 | 187 41 origin (Central, Barycentric, Jacobi) = 188 | 188 0 189 | 189 0 190 | 190 0 191 | 191 0 192 | 192 0 193 | 193 0 194 | 194 0 195 | 195 0 196 | 196 0 197 | 197 0 198 | 198 0 199 | 199 0 200 | 200 0 201 | -------------------------------------------------------------------------------- /Original/swift.inc: -------------------------------------------------------------------------------- 1 | c************************************************************************* 2 | c SWIFT.INC 3 | c************************************************************************* 4 | C Include file for SWIFT 5 | c 6 | c Author: Hal Levison 7 | c Date: 2/2/93 8 | c Last revision: 3/7/93 9 | 10 | implicit NONE ! you got it baby 11 | 12 | c... Maximum array size 13 | integer NPLMAX, NTPMAX 14 | parameter (NPLMAX = 202) ! max number of planets, including the Sun 15 | parameter (NTPMAX = 2000) ! max number of test particles 16 | 17 | c... Size of the test particle status flag 18 | integer NSTAT 19 | parameter (NSTAT = 3) 20 | 21 | c... convergence criteria for danby 22 | real*8 DANBYAC , DANBYB 23 | parameter (DANBYAC= 1.0d-14, DANBYB = 1.0d-13) 24 | 25 | c... loop limits in the Laguerre attempts 26 | integer NLAG1, NLAG2 27 | parameter(NLAG1 = 50, NLAG2 = 400) 28 | 29 | c... A small number 30 | real*8 TINY 31 | PARAMETER(TINY=4.D-15) 32 | 33 | c... trig stuff 34 | real*8 PI,TWOPI,PIBY2,DEGRAD 35 | parameter (PI = 3.141592653589793D0) 36 | parameter (TWOPI = 2.0D0 * PI) 37 | parameter (PIBY2 = PI/2.0D0) 38 | parameter (DEGRAD = 180.0D0 / PI) 39 | 40 | c------------------------------------------------------------------------- 41 | -------------------------------------------------------------------------------- /README.rst: -------------------------------------------------------------------------------- 1 | Mercury6 2 | =============================== 3 | A version to handle binary stars 4 | --------------------------------- 5 | 6 | We've created a modified version of the original Mercury code from John Chambers (http://www.arm.ac.uk/~jec/home.html) that can work for either single stars or binary stars. This uses the exact same input formats as the original. A full explanation of all inputs and outputs is given in ``mercury.man.`` 7 | 8 | If you want a nice python wrapper for initializing Mercury simulations, see Adam Sutherland's code quicksilver at https://github.com/adamsutherland/quicksilver. 9 | 10 | Notable contents of this repository 11 | --------------------------- 12 | 13 | * ``mercury6_ras.for:`` The main program file that has been modified from the original ``mercury6_2.for``. It requires ``mercury.inc`` and ``swift.inc`` to compile. These are the notable changes made within the code. 14 | 15 | + ``mfo_user_centralradius`` allows the user to set the prescription for the central binary radius. 16 | + When the user uses a central binary, the central star is considered as a big body instead of as a central object. 17 | + The calculation of the Hill radius uses the object's location instead of its semi-major axis. Also in this routine, we use a modified Jacobi routine that resorts planets on every call. 18 | + We apply the De Souza Torres & Anderson (2008) bug fix. 19 | + Other changes can be found by searching ``RAS`` in the file. 20 | 21 | * ``close6_ras.for:`` The code to create close encounter files. It requires ``mercury.inc`` and ``swift.inc`` to compile. 22 | * ``element6.for:`` The code to create output element files. It requires ``mercury.inc`` and ``swift.inc`` to compile and has not been modified from the original version. 23 | * ``mercury.inc:`` This is the file that controls the binary. At the bottom, I have added three options for the binary. 24 | 25 | + ``isbinary:`` If you want to have a central binary, set this to ``.TRUE.;`` If you want to run Mercury like the original version, set this to ``.FALSE.``. 26 | + ``cenname:`` The name you want the central object (the primary) to have. 27 | + ``allowclose:`` A flag to allow or forbid close encounters/collisions between the central stars. Use ``.FALSE.`` to forbid and ``.TRUE.`` to allow. If you have a very close binary that is stable for the length of the integration, set this to false to speed up the program. 28 | 29 | * ``Kepler47/:`` This directory contains example input files to run a circumbinary example, Kepler 47. The ephemeris was taken from Kratter and Shannon (2014). To run, compile the code with the ``mercury.inc`` contained in the folder. 30 | * ``SolarSystem/:`` This directory contains example input files to run a single star example (the solar system), as taken from the original Chambers tar file. To run, compile the code with the ``mercury.inc`` contained in the folder. 31 | * ``Original/:`` This contains the unaltered code, just in case. 32 | 33 | 34 | How to compile and run 35 | ---------------------- 36 | 37 | Use your favorite FORTRAN compiler, such as ``gfortran`` or ``f77``, to create an executable. For instance, on Linux or Mac, try:: 38 | 39 | gfortran -o mercury6 mercury6_ras.for 40 | gfortran -o close6 close6_ras.for 41 | gfortran -o element6 element6.for 42 | 43 | There will likely be warnings due to the code being written in FORTRAN77, but it should compile. Copy or link the executable wherever you want (wherever your input files are) to run your code using ``./mercury6``. 44 | 45 | Tricks and Caveats 46 | ------------------ 47 | 48 | Unfortunately, the code needs to be recompiled any time parameters in the ``mercury.inc`` file get changed. 49 | 50 | The binary stars are the central body in the ``param.in`` file and the first body in ``big.in``. 51 | 52 | The coordinates must be in central body. We've found it most reliable to draw our planets in Jacobi coordinates and then convert into central body after. Similarly, we've found it easiest to not rely on the built-in orbital element converter or the output Jacobi coordinate conversion routine, so we prefer to output in central body coordinates and convert after the fact. 53 | 54 | We don't output the change in mass of the central body. If that information is important, it can be reconstructed by adding the mass of bodies that collided. 55 | 56 | 57 | Disclaimers 58 | ------------ 59 | 60 | * This is designed for a central binary. However, it *should* work for a binary with s-type planets, although the radius calculations will have to be tinkered with (alternatively, but untested, try setting your stars as the central object and the first object in the big.in file, regardless of true order?). Use at your own risk. 61 | * The changes have only been tested with the RADAU integrator. Use other integrators at your own risk. 62 | * A routine (``mco_h2jras``) uses a bubble sort algorithm. This can slow things down if you have a lot of massive bodies. 63 | * I've fixed all the errors I've found. If you find a bug, let me know so we can try to fix it. 64 | -------------------------------------------------------------------------------- /SolarSystem/big.in: -------------------------------------------------------------------------------- 1 | )O+_06 Big-body initial data (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | style (Cartesian, Asteroidal, Cometary) = Cartesian 5 | epoch (in days) = 2451000.5 6 | )--------------------------------------------------------------------- 7 | MERCURY m=1.66013679527193009E-07 r=20.D0 d=5.43 8 | -3.83966017419175965E-01 -1.76865300855700736E-01 2.07959213998758705E-02 9 | 5.96286238644834141E-03 -2.43281292146216750E-02 -2.53463209848734695E-03 10 | 0. 0. 0. 11 | VENUS m=2.44783833966454430E-06 r=20.d0 d=5.24 12 | 6.33469157915745540E-01 3.49855234102151691E-01 -3.17853172088953667E-02 13 | -9.84258038001823571E-03 1.76183746921837227E-02 8.08822351013463794E-04 14 | 0. 0. 0. 15 | EARTHMOO m=3.04043264264672381E-06 r=20.d0 d=5.52 16 | 2.42093942183383037E-01 -9.87467766698604366E-01 -4.54276292555233496E-06 17 | 1.64294055023289365E-02 4.03200725816140870E-03 1.13609607260006795E-08 18 | 0. 0. 0. 19 | MARS m=3.22715144505386530E-07 r=20.d0 d=3.94 20 | 2.51831018120174499E-01 1.52598983115984788E+00 2.57781137811807781E-02 21 | -1.32744166042475433E-02 3.46582959610421387E-03 3.98930013246952611E-04 22 | 0. 0. 0. 23 | JUPITER m=9.54791938424326609E-04 r=3.d0 d=1.33 24 | 4.84143144246472090E+00 -1.16032004402742839E+00 -1.03622044471123109E-01 25 | 1.66007664274403694E-03 7.69901118419740425E-03 -6.90460016972063023E-05 26 | 0. 0. 0. 27 | SATURN m=2.85885980666130812E-04 r=3.d0 d=0.70 28 | 8.34336671824457987E+00 4.12479856412430479E+00 -4.03523417114321381E-01 29 | -2.76742510726862411E-03 4.99852801234917238E-03 2.30417297573763929E-05 30 | 0. 0. 0. 31 | URANUS m=4.36624404335156298E-05 r=3.d0 d=1.30 32 | 1.28943695621391310E+01 -1.51111514016986312E+01 -2.23307578892655734E-01 33 | 2.96460137564761618E-03 2.37847173959480950E-03 -2.96589568540237556E-05 34 | 0. 0. 0. 35 | NEPTUNE m=5.15138902046611451E-05 r=3.d0 d=1.76 36 | 1.53796971148509165E+01 -2.59193146099879641E+01 1.79258772950371181E-01 37 | 2.68067772490389322E-03 1.62824170038242295E-03 -9.51592254519715870E-05 38 | 0. 0. 0. 39 | PLUTO m=7.39644970414201173E-09 r=3.d0 d=1.1 40 | -1.15095623952731607E+01 -2.70779438829451422E+01 6.22871533567077229E+00 41 | 2.97220056963797431E-03 -1.69820233395912967E-03 -6.76798264809371094E-04 42 | 0. 0. 0. 43 | -------------------------------------------------------------------------------- /SolarSystem/close.in: -------------------------------------------------------------------------------- 1 | )O+_06 close (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | number of input files = 1 5 | )--------------------------------------------------------------------- 6 | ) List the input files, one per line 7 | ce.out 8 | )--------------------------------------------------------------------- 9 | express time in days or years = years 10 | express time relative to integration start time = yes 11 | )--------------------------------------------------------------------- 12 | ) Which bodies do you want? (List one per line or leave blank for all bodies) 13 | ) 14 | -------------------------------------------------------------------------------- /SolarSystem/element.in: -------------------------------------------------------------------------------- 1 | )O+_06 element (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | number of input files = 1 5 | )--------------------------------------------------------------------- 6 | ) List the input files, one per line 7 | xv.out 8 | )--------------------------------------------------------------------- 9 | type of elements (central body, barycentric, Jacobi) = Cen 10 | minimum interval between outputs (days) = 100. 11 | express time in days or years = years 12 | express time relative to integration start time = yes 13 | )--------------------------------------------------------------------- 14 | ) Output format? (e.g. a8.4 => semi-major axis with 8 digits & 4 dec. places) 15 | m13e a8.5 e8.6 i8.4 x19e y19e z19e u19e v19e w19e 16 | )--------------------------------------------------------------------- 17 | ) Which bodies do you want? (List one per line or leave blank for all bodies) 18 | ) 19 | -------------------------------------------------------------------------------- /SolarSystem/files.in: -------------------------------------------------------------------------------- 1 | big.in 2 | small.in 3 | param.in 4 | xv.out 5 | ce.out 6 | info.out 7 | big.dmp 8 | small.dmp 9 | param.dmp 10 | restart.dmp 11 | -------------------------------------------------------------------------------- /SolarSystem/mercury.inc: -------------------------------------------------------------------------------- 1 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | c 3 | c MERCURY.INC (ErikSoft 4 March 2001) 4 | c 5 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | c 7 | c Author: John E. Chambers 8 | c 9 | c Parameters that you may want to alter at some point: 10 | c 11 | c NMAX = maximum number of bodies 12 | c CMAX = maximum number of close-encounter minima monitored simultaneously 13 | c NMESS = maximum number of messages in message.in 14 | c HUGE = an implausibly large number 15 | c NFILES = maximum number of files that can be open at the same time 16 | c 17 | integer NMAX, CMAX, NMESS, NFILES 18 | real*8 HUGE 19 | c 20 | parameter (NMAX = 2000) 21 | parameter (CMAX = 50) 22 | parameter (NMESS = 200) 23 | parameter (HUGE = 9.9d29) 24 | parameter (NFILES = 50) 25 | c 26 | c------------------------------------------------------------------------------ 27 | c 28 | c Constants: 29 | c 30 | c DR = conversion factor from degrees to radians 31 | c K2 = Gaussian gravitational constant squared 32 | c AU = astronomical unit in cm 33 | c MSUN = mass of the Sun in g 34 | c 35 | real*8 PI,TWOPI,PIBY2,DR,K2,AU,MSUN 36 | c 37 | parameter (PI = 3.141592653589793d0) 38 | parameter (TWOPI = PI * 2.d0) 39 | parameter (PIBY2 = PI * .5d0) 40 | parameter (DR = PI / 180.d0) 41 | parameter (K2 = 2.959122082855911d-4) 42 | parameter (AU = 1.4959787e13) 43 | parameter (MSUN = 1.9891e33) 44 | 45 | c RAS additions for binary 46 | 47 | c Is this a binary? (yes=.TRUE. no=.FALSE.) 48 | logical isbinary 49 | parameter (isbinary = .FALSE.) 50 | c Name for the central object ("foo") 51 | character*16 cenname 52 | parameter (cenname="STAR1") 53 | c Do we allow collisions or close encounters between the binary stars? (yes=.TRUE. no=.FALSE.) 54 | logical allowclose 55 | parameter (allowclose = .FALSE.) 56 | -------------------------------------------------------------------------------- /SolarSystem/message.in: -------------------------------------------------------------------------------- 1 | 1 6 days 2 | 2 6 years 3 | 3 13 solar masses 4 | 4 3 AU 5 | 5 3 no 6 | 6 3 yes 7 | 7 3 low 8 | 8 6 medium 9 | 9 4 high 10 | 10 0 11 | 11 33 Integration parameters 12 | 12 33 ---------------------- 13 | 13 14 Algorithm: 14 | 14 38 Second-order mixed-variable symplectic 15 | 15 24 Bulirsch-Stoer (general) 16 | 16 37 Bulirsch-Stoer (conservative systems) 17 | 17 16 15th-order RADAU 18 | 18 0 19 | 19 0 20 | 20 0 21 | 21 0 22 | 22 5 Test 23 | 23 48 Hybrid symplectic integrator (mixed coordinates) 24 | 24 44 Hybrid symplectic (close binary coordinates) 25 | 25 43 Hybrid symplectic (wide binary coordinates) 26 | 26 32 Integration start epoch: 27 | 27 32 Integration stop epoch: 28 | 28 32 Output interval: 29 | 29 32 Element origin: 30 | 30 31 Initial timestep: 31 | 31 36 Accuracy parameter: 32 | 32 36 Central mass: 33 | 33 36 J_2: 34 | 34 36 J_4: 35 | 35 36 J_6: 36 | 36 36 Ejection distance: 37 | 37 36 Radius of central body: 38 | 38 29 Number of Big bodies: 39 | 39 29 Number of Small bodies: 40 | 40 37 Output precision: 41 | 41 40 Includes collisions: 42 | 42 40 Includes fragmentation: 43 | 43 0 44 | 44 0 45 | 45 40 Includes relativity: 46 | 46 40 Includes user-defined force routine: 47 | 47 10 barycentre 48 | 48 12 central body 49 | 49 0 50 | 50 0 51 | 51 30 Integration details 52 | 52 30 ------------------- 53 | 53 29 Initial energy: 54 | 54 29 Initial angular momentum: 55 | 55 65 Integrating massive bodies and particles up to the same epoch. 56 | 56 34 Beginning the main integration. 57 | 57 24 Integration complete. 58 | 58 48 Fractional energy change due to integrator: 59 | 59 48 Fractional angular momentum change: 60 | 60 57 Fractional energy change due to collisions/ejections: 61 | 61 57 Fractional angular momentum change: 62 | 62 47 Continuing integration from dump files at 63 | 63 6 Time: 64 | 64 6 Date: 65 | 65 9 dE/E: 66 | 66 9 dL/L: 67 | 67 35 collided with the central body at 68 | 68 12 ejected at 69 | 69 12 was hit by 70 | 70 34 removed due to an encounter with 71 | 71 4 at 72 | 72 26 solar masses AU^2 day^-2 73 | 73 26 solar masses AU^2 day^-1 74 | 74 36 lost mass due to rotational breakup 75 | 75 24 removed due to small a 76 | 76 0 77 | 77 0 78 | 78 0 79 | 79 0 80 | 80 0 81 | 81 8 ERROR: 82 | 82 49 Modify mercury.inc and recompile Mercury. 83 | 83 62 Check the file containing initial data for Big bodies. 84 | 84 64 Check the file containing initial data for Small bodies. 85 | 85 57 Check the file containing integration parameters. 86 | 86 22 Check files.in 87 | 87 27 This file already exists: 88 | 88 34 This file is needed to continue: 89 | 89 30 This filename is duplicated: 90 | 90 40 The total number of bodies exceeds NMAX. 91 | 91 68 Data style on first line must be Cartesian, Asteroidal or Cometary 92 | 92 68 You cannot integrate non-gravitational forces using this algorithm. 93 | 93 64 You cannot integrate a user-defined force using this algorithm. 94 | 94 64 You cannot integrate massive Small bodies using this algorithm. 95 | 95 66 Massive Small bodies must have the same epoch as the Big bodies. 96 | 96 49 Check character implies input file is corrupted. 97 | 97 62 Mass, density, encounter limit must be >= 0 for this object: 98 | 98 46 This integration algorithm is not available: 99 | 99 50 A problem occurred reading the parameter on line 100 | 100 50 A problem occurred reading data for this object: 101 | 101 56 A problem occured reading the epoch for the Big bodies. 102 | 102 67 You cannot use non-zero J2,J4,J6 using the close-binary algorithm. 103 | 103 34 Two objects both have this name: 104 | 104 36 is corrupted at line number: 105 | 105 42 Central-body radius exceeds maximum radius. 106 | 106 68 Maximum/Central radius is large. Output precision will be degraded. 107 | 107 58 Coordinate origin must be Central, Barycentric or Jacobi. 108 | 108 0 109 | 109 0 110 | 110 0 111 | 111 0 112 | 112 0 113 | 113 0 114 | 114 0 115 | 115 0 116 | 116 0 117 | 117 0 118 | 118 0 119 | 119 0 120 | 120 0 121 | 121 10 WARNING: 122 | 122 53 Truncating the name of this object to 8 characters: 123 | 123 30 Main integration is backwards. 124 | 124 26 No Big bodies are present. 125 | 125 28 No Small bodies are present. 126 | 126 50 Stopping integration due to an encounter between 127 | 127 45 Throwing this object into the central body: 128 | 128 42 Setting output threshhold DA to infinity. 129 | 129 42 Setting output threshhold DE to infinity. 130 | 130 42 Setting output threshhold DI to infinity. 131 | 131 43 Increasing the radius of the central body. 132 | 132 56 Total number of current close encounters exceeds CMAX. 133 | 133 0 134 | 134 0 135 | 135 0 136 | 136 0 137 | 137 0 138 | 138 0 139 | 139 0 140 | 140 0 141 | 141 0 142 | 142 0 143 | 143 0 144 | 144 0 145 | 145 0 146 | 146 0 147 | 147 0 148 | 148 0 149 | 149 0 150 | 150 0 151 | 151 67 )O+_05 Integration parameters (WARNING: Do not delete this line!!) 152 | 152 66 )O+_05 Big-body initial data (WARNING: Do not delete this line!!) 153 | 153 68 )O+_05 Small-body initial data (WARNING: Do not delete this line!!) 154 | 154 39 ) Lines beginning with `)' are ignored. 155 | 155 70 )--------------------------------------------------------------------- 156 | 156 43 style (Cartesian, Asteroidal, Cometary) = 157 | 157 20 epoch (in days) = 158 | 158 35 ) Important integration parameters: 159 | 159 48 algorithm (MVS, BS, BS2, RADAU, HYBRID etc) = 160 | 160 21 start time (days) = 161 | 161 20 stop time (days) = 162 | 162 26 output interval (days) = 163 | 163 19 timestep (days) = 164 | 164 22 accuracy parameter = 165 | 165 22 ) Integration options: 166 | 166 44 stop integration after a close encounter = 167 | 167 29 allow collisions to occur = 168 | 168 37 include collisional fragmentation = 169 | 169 33 express time in days or years = 170 | 170 51 express time relative to integration start time = 171 | 171 20 output precision = 172 | 172 24 < Not used at present > 173 | 173 37 include relativity in integration = 174 | 174 30 include user-defined force = 175 | 175 52 ) These parameters do not need to be adjusted often: 176 | 176 26 ejection distance (AU) = 177 | 177 31 radius of central body (AU) = 178 | 178 31 central mass (solar masses) = 179 | 179 14 central J2 = 180 | 180 14 central J4 = 181 | 181 14 central J6 = 182 | 182 24 < Not used at present > 183 | 183 24 < Not used at present > 184 | 184 45 Hybrid integrator changeover (Hill radii) = 185 | 185 42 number of timesteps between data dumps = 186 | 186 48 number of timesteps between periodic effects = 187 | 187 41 origin (Central, Barycentric, Jacobi) = 188 | 188 0 189 | 189 0 190 | 190 0 191 | 191 0 192 | 192 0 193 | 193 0 194 | 194 0 195 | 195 0 196 | 196 0 197 | 197 0 198 | 198 0 199 | 199 0 200 | 200 0 201 | -------------------------------------------------------------------------------- /SolarSystem/param.in: -------------------------------------------------------------------------------- 1 | )O+_06 Integration parameters (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | ) Important integration parameters: 5 | )--------------------------------------------------------------------- 6 | algorithm (MVS, BS, BS2, RADAU, HYBRID etc) = mvs 7 | start time (days)= 0. 8 | stop time (days) =10000. 9 | output interval (days) = 100. 10 | timestep (days) = 10. 11 | accuracy parameter=1.d-12 12 | )--------------------------------------------------------------------- 13 | ) Integration options: 14 | )--------------------------------------------------------------------- 15 | stop integration after a close encounter = no 16 | allow collisions to occur = no 17 | include collisional fragmentation = no 18 | express time in days or years = years 19 | express time relative to integration start time = no 20 | output precision = medium 21 | < not used at present > 22 | include relativity in integration= no 23 | include user-defined force = no 24 | )--------------------------------------------------------------------- 25 | ) These parameters do not need to be adjusted often: 26 | )--------------------------------------------------------------------- 27 | ejection distance (AU)= 100 28 | radius of central body (AU) = 0.005 29 | central mass (solar) = 1.0 30 | central J2 = 0 31 | central J4 = 0 32 | central J6 = 0 33 | < not used at present > 34 | < not used at present > 35 | Hybrid integrator changeover (Hill radii) = 3. 36 | number of timesteps between data dumps = 100 37 | number of timesteps between periodic effects = 1 38 | -------------------------------------------------------------------------------- /SolarSystem/small.in: -------------------------------------------------------------------------------- 1 | )O+_06 Small-body initial data (WARNING: Do not delete this line!!) 2 | ) Lines beginning with `)' are ignored. 3 | )--------------------------------------------------------------------- 4 | style (Cartesian, Asteroidal, Cometary) = Ast 5 | )--------------------------------------------------------------------- 6 | APOLLO ep=2450400.5 7 | 1.4710345 .5600245 6.35621 285.63908 35.92313 15.77656 0 0 0 8 | JASON Ep=2450400.5 9 | 2.2157309 .7644575 4.84834 336.49610 169.94137 293.37226 0 0 0 10 | KHUFU ep=2450600.5 11 | 0.9894948 .4685310 9.91298 54.85927 152.64772 66.69818 0 0 0 12 | MINOS ep=2450400.5 13 | 1.1513383 .4127106 3.93863 239.50170 344.85893 8.93445 0 0 0 14 | ORPHEUS ep=2450400.5 15 | 1.2091305 .3226805 2.68180 301.55128 189.79654 28.31467 0 0 0 16 | TOUTATIS EP=2450600.5 17 | 2.5119660 .6335854 0.46976 274.82273 128.20968 50.00728 0 0 0 18 | -------------------------------------------------------------------------------- /close6_ras.for: -------------------------------------------------------------------------------- 1 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | c 3 | c CLOSE6_RAS.FOR 4 | c 5 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | c 7 | c Author of changes: Rachel A Smullen (rsmullen@email.arizona.edu) 8 | c Date of last edit: 5 Jan 2016 9 | c Source code available on https://github.com/rsmullen/mercury6_binary 10 | c 11 | c The only modification is to allow for the central body name to be output 12 | c Search RAS for location of changes 13 | 14 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 15 | c 16 | c CLOSE6.FOR (ErikSoft 5 June 2001) 17 | c 18 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 19 | c 20 | c Author: John E. Chambers 21 | c 22 | c Makes output files containing details of close encounters that occurred 23 | c during an integration using Mercury6 or higher. 24 | c 25 | c The user specifies the names of the required objects in the file close.in 26 | c 27 | c------------------------------------------------------------------------------ 28 | c 29 | implicit none 30 | include 'mercury.inc' 31 | c 32 | integer itmp,i,j,k,l,iclo,jclo,precision,lenin 33 | integer nmaster,nopen,nwait,nbig,nsml,nsub,lim(2,100) 34 | integer year,month,timestyle,line_num,lenhead,lmem(NMESS) 35 | integer nchar,algor,allflag,firstflag,ninfile 36 | integer unit(NMAX),master_unit(NMAX) 37 | real*8 time,t0,t1,rmax,rcen,rfac,dclo,mcen,jcen(3) 38 | real*8 mio_c2re, mio_c2fl,fr,theta,phi,fv,vtheta,vphi,gm 39 | real*8 x1(3),x2(3),v1(3),v2(3),m(NMAX) 40 | real*8 a1,a2,e1,e2,i1,i2,p1,p2,n1,n2,l1,l2,q1,q2 41 | logical test 42 | character*250 string,fout,header,infile(50) 43 | character*80 mem(NMESS),cc,c(NMAX) 44 | character*8 master_id(NMAX),id(NMAX) 45 | character*5 fin 46 | character*1 check,style,type,c1 47 | c 48 | c------------------------------------------------------------------------------ 49 | c 50 | allflag = 0 51 | c 52 | c Read in output messages 53 | inquire (file='message.in', exist=test) 54 | if (.not.test) then 55 | write (*,'(/,2a)') ' ERROR: This file is needed to continue: ', 56 | % ' message.in' 57 | stop 58 | end if 59 | open (14, file='message.in', status='old') 60 | 10 continue 61 | read (14,'(i3,1x,i2,1x,a80)',end=20) j,lmem(j),mem(j) 62 | goto 10 63 | 20 close (14) 64 | c 65 | c Open file containing parameters for this programme 66 | inquire (file='close.in', exist=test) 67 | if (test) then 68 | open (10, file='close.in', status='old') 69 | else 70 | call mio_err (6,mem(81),lmem(81),mem(88),lmem(88),' ',1, 71 | % 'close.in',9) 72 | end if 73 | c 74 | c Read number of input files 75 | 30 read (10,'(a250)') string 76 | if (string(1:1).eq.')') goto 30 77 | call mio_spl (250,string,nsub,lim) 78 | read (string(lim(1,nsub):lim(2,nsub)),*) ninfile 79 | c 80 | c Make sure all the input files exist 81 | do j = 1, ninfile 82 | 40 read (10,'(a250)') string 83 | if (string(1:1).eq.')') goto 40 84 | call mio_spl (250,string,nsub,lim) 85 | infile(j)(1:(lim(2,1)-lim(1,1)+1)) = string(lim(1,1):lim(2,1)) 86 | inquire (file=infile(j), exist=test) 87 | if (.not.test) call mio_err (6,mem(81),lmem(81),mem(88), 88 | % lmem(88),' ',1,infile(j),80) 89 | end do 90 | c 91 | c Read parameters used by this programme 92 | timestyle = 1 93 | do j = 1, 2 94 | 50 read (10,'(a250)') string 95 | if (string(1:1).eq.')') goto 50 96 | call mio_spl (250,string,nsub,lim) 97 | c1 = string(lim(1,nsub):lim(2,nsub)) 98 | if (j.eq.1.and.(c1.eq.'d'.or.c1.eq.'D')) timestyle = 0 99 | if (j.eq.2.and.(c1.eq.'y'.or.c1.eq.'Y')) timestyle = timestyle+2 100 | end do 101 | c 102 | c Read in the names of the objects for which orbital elements are required 103 | nopen = 0 104 | nwait = 0 105 | nmaster = 0 106 | call m_formce (timestyle,fout,header,lenhead) 107 | 60 continue 108 | read (10,'(a250)',end=70) string 109 | call mio_spl (250,string,nsub,lim) 110 | if (string(1:1).eq.')'.or.lim(1,1).eq.-1) goto 60 111 | c 112 | c Either open an aei file for this object or put it on the waiting list 113 | nmaster = nmaster + 1 114 | itmp = min(7,lim(2,1)-lim(1,1)) 115 | master_id(nmaster)=' ' 116 | master_id(nmaster)(1:itmp+1) = string(lim(1,1):lim(1,1)+itmp) 117 | if (nopen.lt.NFILES) then 118 | nopen = nopen + 1 119 | master_unit(nmaster) = 10 + nopen 120 | call mio_aei (master_id(nmaster),'.clo',master_unit(nmaster), 121 | % header,lenhead,mem,lmem) 122 | else 123 | nwait = nwait + 1 124 | master_unit(nmaster) = -2 125 | end if 126 | goto 60 127 | c 128 | 70 continue 129 | c If no objects are listed in CLOSE.IN assume that all objects are required 130 | if (nopen.eq.0) allflag = 1 131 | close (10) 132 | c 133 | c------------------------------------------------------------------------------ 134 | c 135 | c LOOP OVER EACH INPUT FILE CONTAINING INTEGRATION DATA 136 | c 137 | 90 continue 138 | firstflag = 0 139 | do i = 1, ninfile 140 | line_num = 0 141 | open (10, file=infile(i), status='old') 142 | c 143 | c Loop over each time slice 144 | 100 continue 145 | line_num = line_num + 1 146 | read (10,'(3a1)',end=900,err=666) check,style,type 147 | line_num = line_num - 1 148 | backspace 10 149 | c 150 | c Check if this is an old style input file 151 | if (ichar(check).eq.12.and.(style.eq.'0'.or.style.eq.'1'.or. 152 | % style.eq.'2'.or.style.eq.'3'.or.style.eq.'4')) then 153 | write (*,'(/,2a)') ' ERROR: This is an old style data file', 154 | % ' Try running m_close5.for instead.' 155 | stop 156 | end if 157 | if (ichar(check).ne.12) goto 666 158 | c 159 | c------------------------------------------------------------------------------ 160 | c 161 | c IF SPECIAL INPUT, READ TIME, PARAMETERS, NAMES, MASSES ETC. 162 | c 163 | if (type.eq.'a') then 164 | line_num = line_num + 1 165 | read (10,'(3x,i2,a62,i1)') algor,cc(1:62),precision 166 | c 167 | c Decompress the time, number of objects, central mass and J components etc. 168 | time = mio_c2fl (cc(1:8)) 169 | if (firstflag.eq.0) then 170 | t0 = time 171 | firstflag = 1 172 | end if 173 | nbig = int(.5d0 + mio_c2re(cc(9:16), 0.d0, 11239424.d0, 3)) 174 | nsml = int(.5d0 + mio_c2re(cc(12:19),0.d0, 11239424.d0, 3)) 175 | mcen = mio_c2fl (cc(15:22)) * K2 176 | jcen(1) = mio_c2fl (cc(23:30)) 177 | jcen(2) = mio_c2fl (cc(31:38)) 178 | jcen(3) = mio_c2fl (cc(39:46)) 179 | rcen = mio_c2fl (cc(47:54)) 180 | rmax = mio_c2fl (cc(55:62)) 181 | rfac = log10 (rmax / rcen) 182 | c 183 | c Read in strings containing compressed data for each object 184 | do j = 1, nbig + nsml 185 | line_num = line_num + 1 186 | read (10,'(a)',err=666) c(j)(1:51) 187 | end do 188 | c 189 | c Create input format list 190 | if (precision.eq.1) nchar = 2 191 | if (precision.eq.2) nchar = 4 192 | if (precision.eq.3) nchar = 7 193 | lenin = 3 + 6 * nchar 194 | fin(1:5) = '(a00)' 195 | write (fin(3:4),'(i2)') lenin 196 | c 197 | c For each object decompress its name, code number, mass, spin and density 198 | do j = 1, nbig + nsml 199 | k = int(.5d0 + mio_c2re(c(j)(1:8),0.d0,11239424.d0,3)) 200 | id(k) = c(j)(4:11) 201 | m(k) = mio_c2fl (c(j)(12:19)) * K2 202 | c 203 | c Find the object on the master list 204 | unit(k) = 0 205 | do l = 1, nmaster 206 | if (id(k).eq.master_id(l)) unit(k) = master_unit(l) 207 | end do 208 | c 209 | c If object is not on the master list, add it to the list now 210 | if (unit(k).eq.0) then 211 | nmaster = nmaster + 1 212 | master_id(nmaster) = id(k) 213 | c 214 | c Either open an aei file for this object or put it on the waiting list 215 | if (allflag.eq.1) then 216 | if (nopen.lt.NFILES) then 217 | nopen = nopen + 1 218 | master_unit(nmaster) = 10 + nopen 219 | call mio_aei (master_id(nmaster),'.clo', 220 | % master_unit(nmaster),header,lenhead,mem,lmem) 221 | else 222 | nwait = nwait + 1 223 | master_unit(nmaster) = -2 224 | end if 225 | else 226 | master_unit(nmaster) = -1 227 | end if 228 | unit(k) = master_unit(nmaster) 229 | end if 230 | end do 231 | c 232 | c------------------------------------------------------------------------------ 233 | c 234 | c IF NORMAL INPUT, READ COMPRESSED DATA ON THE CLOSE ENCOUNTER 235 | c 236 | else if (type.eq.'b') then 237 | line_num = line_num + 1 238 | read (10,'(3x,a70)',err=666) cc(1:70) 239 | c 240 | c Decompress time, distance and orbital variables for each object 241 | time = mio_c2fl (cc(1:8)) 242 | iclo = int(.5d0 + mio_c2re(cc(9:16), 0.d0, 11239424.d0, 3)) 243 | jclo = int(.5d0 + mio_c2re(cc(12:19), 0.d0, 11239424.d0, 3)) 244 | if (iclo.gt.NMAX.or.jclo.gt.NMAX) then 245 | write (*,'(/,2a)') mem(81)(1:lmem(81)), 246 | % mem(90)(1:lmem(90)) 247 | stop 248 | end if 249 | dclo = mio_c2fl (cc(15:22)) 250 | fr = mio_c2re (cc(23:30), 0.d0, rfac, 4) 251 | theta = mio_c2re (cc(27:34), 0.d0, PI, 4) 252 | phi = mio_c2re (cc(31:38), 0.d0, TWOPI, 4) 253 | fv = mio_c2re (cc(35:42), 0.d0, 1.d0, 4) 254 | vtheta = mio_c2re (cc(39:46), 0.d0, PI, 4) 255 | vphi = mio_c2re (cc(43:50), 0.d0, TWOPI, 4) 256 | call mco_ov2x (rcen,rmax,mcen,m(iclo),fr,theta,phi,fv, 257 | % vtheta,vphi,x1(1),x1(2),x1(3),v1(1),v1(2),v1(3)) 258 | c 259 | fr = mio_c2re (cc(47:54), 0.d0, rfac, 4) 260 | theta = mio_c2re (cc(51:58), 0.d0, PI, 4) 261 | phi = mio_c2re (cc(55:62), 0.d0, TWOPI, 4) 262 | fv = mio_c2re (cc(59:66), 0.d0, 1.d0, 4) 263 | vtheta = mio_c2re (cc(63:70), 0.d0, PI, 4) 264 | vphi = mio_c2re (cc(67:74), 0.d0, TWOPI, 4) 265 | call mco_ov2x (rcen,rmax,mcen,m(jclo),fr,theta,phi,fv, 266 | % vtheta,vphi,x2(1),x2(2),x2(3),v2(1),v2(2),v2(3)) 267 | c 268 | c Convert to Keplerian elements 269 | gm = mcen + m(iclo) 270 | call mco_x2el (gm,x1(1),x1(2),x1(3),v1(1),v1(2),v1(3), 271 | % q1,e1,i1,p1,n1,l1) 272 | a1 = q1 / (1.d0 - e1) 273 | gm = mcen + m(jclo) 274 | call mco_x2el (gm,x2(1),x2(2),x2(3),v2(1),v2(2),v2(3), 275 | % q2,e2,i2,p2,n2,l2) 276 | a2 = q2 / (1.d0 - e2) 277 | i1 = i1 / DR 278 | i2 = i2 / DR 279 | c 280 | c Convert time to desired format 281 | if (timestyle.eq.0) t1 = time 282 | if (timestyle.eq.1) call mio_jd_y (time,year,month,t1) 283 | if (timestyle.eq.2) t1 = time - t0 284 | if (timestyle.eq.3) t1 = (time - t0) / 365.25d0 285 | c 286 | c Write encounter details to appropriate files 287 | if (isbinary) then 288 | c RAS Changed to hack output of central body name (cenname from mercury.inc) 289 | if (timestyle.eq.1) then 290 | if (unit(iclo).ge.10) then 291 | if (jclo.eq.0) then 292 | write (unit(iclo),fout) year,month, 293 | % t1,cenname,dclo,a1,e1,i1,a2,e2,i2 294 | else 295 | write (unit(iclo),fout) year,month, 296 | % t1,id(jclo),dclo,a1,e1,i1,a2,e2,i2 297 | endif 298 | endif 299 | if (unit(jclo).ge.10) then 300 | if (iclo.eq.0) then 301 | write (unit(jclo),fout) year,month, 302 | % t1,cenname,dclo,a2,e2,i2,a1,e1,i1 303 | else 304 | write (unit(jclo),fout) year,month, 305 | % t1,id(iclo),dclo,a2,e2,i2,a1,e1,i1 306 | endif 307 | endif 308 | else 309 | if (unit(iclo).ge.10) then 310 | if (jclo.eq.0) then 311 | write (unit(iclo),fout) t1,cenname, 312 | % dclo,a1,e1,i1,a2,e2,i2 313 | else 314 | write (unit(iclo),fout) t1,id(jclo), 315 | % dclo,a1,e1,i1,a2,e2,i2 316 | endif 317 | endif 318 | if (unit(jclo).ge.10) then 319 | if (iclo.eq.0) then 320 | write (unit(jclo),fout) t1,cenname, 321 | % dclo,a2,e2,i2,a1,e1,i1 322 | else 323 | write (unit(jclo),fout) t1,id(iclo), 324 | % dclo,a2,e2,i2,a1,e1,i1 325 | endif 326 | endif 327 | end if 328 | else 329 | if (timestyle.eq.1) then 330 | if (unit(iclo).ge.10) write (unit(iclo),fout) year,month, 331 | % t1,id(jclo),dclo,a1,e1,i1,a2,e2,i2 332 | c 333 | if (unit(jclo).ge.10) write (unit(jclo),fout) year,month, 334 | % t1,id(iclo),dclo,a2,e2,i2,a1,e1,i1 335 | else 336 | if (unit(iclo).ge.10) write (unit(iclo),fout) t1,id(jclo), 337 | % dclo,a1,e1,i1,a2,e2,i2 338 | if (unit(jclo).ge.10) write (unit(jclo),fout) t1,id(iclo), 339 | % dclo,a2,e2,i2,a1,e1,i1 340 | end if 341 | endif 342 | c 343 | c------------------------------------------------------------------------------ 344 | c 345 | c IF TYPE IS NOT 'a' OR 'b', THE INPUT FILE IS CORRUPTED 346 | c 347 | else 348 | goto 666 349 | end if 350 | c 351 | c Move on to the next time slice 352 | goto 100 353 | c 354 | c If input file is corrupted, try to continue from next uncorrupted time slice 355 | 666 continue 356 | write (*,'(2a,/,a,i10)') mem(121)(1:lmem(121)), 357 | % infile(i)(1:60),mem(104)(1:lmem(104)),line_num 358 | c1 = ' ' 359 | do while (ichar(c1).ne.12) 360 | line_num = line_num + 1 361 | read (10,'(a1)',end=900) c1 362 | end do 363 | line_num = line_num - 1 364 | backspace 10 365 | c 366 | c Move on to the next file containing close encounter data 367 | 900 continue 368 | close (10) 369 | end do 370 | c 371 | c Close clo files 372 | do j = 1, nopen 373 | close (10+j) 374 | end do 375 | nopen = 0 376 | c 377 | c If some objects remain on waiting list, read through input files again 378 | if (nwait.gt.0) then 379 | do j = 1, nmaster 380 | if (master_unit(j).ge.10) master_unit(j) = -1 381 | if (master_unit(j).eq.-2.and.nopen.lt.NFILES) then 382 | nopen = nopen + 1 383 | nwait = nwait - 1 384 | master_unit(j) = 10 + nopen 385 | call mio_aei (master_id(j),'.clo',master_unit(j),header, 386 | % lenhead,mem,lmem) 387 | end if 388 | end do 389 | goto 90 390 | end if 391 | c 392 | end 393 | c 394 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 395 | c 396 | c M_FORMCE.FOR (ErikSoft 30 November 1999) 397 | c 398 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 399 | c 400 | c Author: John E. Chambers 401 | c 402 | c 403 | c------------------------------------------------------------------------------ 404 | c 405 | subroutine m_formce (timestyle,fout,header,lenhead) 406 | c 407 | implicit none 408 | c 409 | c Input/Output 410 | integer timestyle,lenhead 411 | character*250 fout,header 412 | c 413 | c------------------------------------------------------------------------------ 414 | c 415 | if (timestyle.eq.0.or.timestyle.eq.2) then 416 | header(1:19) = ' Time (days) ' 417 | header(20:58) = ' Object dmin (AU) a1 e1 ' 418 | header(59:90) = ' i1 a2 e2 i2' 419 | lenhead = 90 420 | fout = '(1x,f18.5,1x,a8,1x,f10.8,2(1x,f9.4,1x,f8.6,1x,f7.3))' 421 | else 422 | if (timestyle.eq.1) then 423 | header(1:23) = ' Year/Month/Day ' 424 | header(24:62) = ' Object dmin (AU) a1 e1 ' 425 | header(63:94) = ' i1 a2 e2 i2' 426 | lenhead = 94 427 | fout(1:37) = '(1x,i10,1x,i2,1x,f8.5,1x,a8,1x,f10.8,' 428 | fout(38:64) = '2(1x,f9.4,1x,f8.6,1x,f7.3))' 429 | else 430 | header(1:19) = ' Time (years) ' 431 | header(20:58) = ' Object dmin (AU) a1 e1 ' 432 | header(59:90) = ' i1 a2 e2 i2' 433 | fout = '(1x,f18.7,1x,a8,1x,f10.8,2(1x,f9.4,1x,f8.6,1x,f7.3))' 434 | lenhead = 90 435 | end if 436 | end if 437 | c 438 | c------------------------------------------------------------------------------ 439 | c 440 | return 441 | end 442 | c 443 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 444 | c 445 | c MCO_OV2X.FOR (ErikSoft 28 February 2001) 446 | c 447 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 448 | c 449 | c Author: John E. Chambers 450 | c 451 | c Converts output variables for an object to coordinates and velocities. 452 | c The output variables are: 453 | c r = the radial distance 454 | c theta = polar angle 455 | c phi = azimuthal angle 456 | c fv = 1 / [1 + 2(ke/be)^2], where be and ke are the object's binding and 457 | c kinetic energies. (Note that 0 < fv < 1). 458 | c vtheta = polar angle of velocity vector 459 | c vphi = azimuthal angle of the velocity vector 460 | c 461 | c------------------------------------------------------------------------------ 462 | c 463 | subroutine mco_ov2x (rcen,rmax,mcen,m,fr,theta,phi,fv,vtheta, 464 | % vphi,x,y,z,u,v,w) 465 | c 466 | implicit none 467 | include 'mercury.inc' 468 | c 469 | c Input/Output 470 | real*8 rcen,rmax,mcen,m,x,y,z,u,v,w,fr,theta,phi,fv,vtheta,vphi 471 | c 472 | c Local 473 | real*8 r,v1,temp 474 | c 475 | c------------------------------------------------------------------------------ 476 | c 477 | r = rcen * 10.d0**fr 478 | temp = sqrt(.5d0*(1.d0/fv - 1.d0)) 479 | v1 = sqrt(2.d0 * temp * (mcen + m) / r) 480 | c 481 | x = r * sin(theta) * cos(phi) 482 | y = r * sin(theta) * sin(phi) 483 | z = r * cos(theta) 484 | u = v1 * sin(vtheta) * cos(vphi) 485 | v = v1 * sin(vtheta) * sin(vphi) 486 | w = v1 * cos(vtheta) 487 | c 488 | c------------------------------------------------------------------------------ 489 | c 490 | return 491 | end 492 | c 493 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 494 | c 495 | c MCO_EL2X.FOR (ErikSoft 7 July 1999) 496 | c 497 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 498 | c 499 | c Author: John E. Chambers 500 | c 501 | c Calculates Cartesian coordinates and velocities given Keplerian orbital 502 | c elements (for elliptical, parabolic or hyperbolic orbits). 503 | c 504 | c Based on a routine from Levison and Duncan's SWIFT integrator. 505 | c 506 | c mu = grav const * (central + secondary mass) 507 | c q = perihelion distance 508 | c e = eccentricity 509 | c i = inclination ) 510 | c p = longitude of perihelion !!! ) in 511 | c n = longitude of ascending node ) radians 512 | c l = mean anomaly ) 513 | c 514 | c x,y,z = Cartesian positions ( units the same as a ) 515 | c u,v,w = " velocities ( units the same as sqrt(mu/a) ) 516 | c 517 | c------------------------------------------------------------------------------ 518 | c 519 | subroutine mco_el2x (mu,q,e,i,p,n,l,x,y,z,u,v,w) 520 | c 521 | implicit none 522 | include 'mercury.inc' 523 | c 524 | c Input/Output 525 | real*8 mu,q,e,i,p,n,l,x,y,z,u,v,w 526 | c 527 | c Local 528 | real*8 g,a,ci,si,cn,sn,cg,sg,ce,se,romes,temp 529 | real*8 z1,z2,z3,z4,d11,d12,d13,d21,d22,d23 530 | real*8 mco_kep, orbel_fhybrid, orbel_zget 531 | c 532 | c------------------------------------------------------------------------------ 533 | c 534 | c Change from longitude of perihelion to argument of perihelion 535 | g = p - n 536 | c 537 | c Rotation factors 538 | call mco_sine (i,si,ci) 539 | call mco_sine (g,sg,cg) 540 | call mco_sine (n,sn,cn) 541 | z1 = cg * cn 542 | z2 = cg * sn 543 | z3 = sg * cn 544 | z4 = sg * sn 545 | d11 = z1 - z4*ci 546 | d12 = z2 + z3*ci 547 | d13 = sg * si 548 | d21 = -z3 - z2*ci 549 | d22 = -z4 + z1*ci 550 | d23 = cg * si 551 | c 552 | c Semi-major axis 553 | a = q / (1.d0 - e) 554 | c 555 | c Ellipse 556 | if (e.lt.1.d0) then 557 | romes = sqrt(1.d0 - e*e) 558 | temp = mco_kep (e,l) 559 | call mco_sine (temp,se,ce) 560 | z1 = a * (ce - e) 561 | z2 = a * romes * se 562 | temp = sqrt(mu/a) / (1.d0 - e*ce) 563 | z3 = -se * temp 564 | z4 = romes * ce * temp 565 | else 566 | c Parabola 567 | if (e.eq.1.d0) then 568 | ce = orbel_zget(l) 569 | z1 = q * (1.d0 - ce*ce) 570 | z2 = 2.d0 * q * ce 571 | z4 = sqrt(2.d0*mu/q) / (1.d0 + ce*ce) 572 | z3 = -ce * z4 573 | else 574 | c Hyperbola 575 | romes = sqrt(e*e - 1.d0) 576 | temp = orbel_fhybrid(e,l) 577 | call mco_sinh (temp,se,ce) 578 | z1 = a * (ce - e) 579 | z2 = -a * romes * se 580 | temp = sqrt(mu/abs(a)) / (e*ce - 1.d0) 581 | z3 = -se * temp 582 | z4 = romes * ce * temp 583 | end if 584 | endif 585 | c 586 | x = d11*z1 + d21*z2 587 | y = d12*z1 + d22*z2 588 | z = d13*z1 + d23*z2 589 | u = d11*z3 + d21*z4 590 | v = d12*z3 + d22*z4 591 | w = d13*z3 + d23*z4 592 | c 593 | c------------------------------------------------------------------------------ 594 | c 595 | return 596 | end 597 | c 598 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 599 | c 600 | c MCO_KEP.FOR (ErikSoft 7 July 1999) 601 | c 602 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 603 | c 604 | c Author: John E. Chambers 605 | c 606 | c Solves Kepler's equation for eccentricities less than one. 607 | c Algorithm from A. Nijenhuis (1991) Cel. Mech. Dyn. Astron. 51, 319-330. 608 | c 609 | c e = eccentricity 610 | c l = mean anomaly (radians) 611 | c u = eccentric anomaly ( " ) 612 | c 613 | c------------------------------------------------------------------------------ 614 | c 615 | function mco_kep (e,oldl) 616 | implicit none 617 | c 618 | c Input/Outout 619 | real*8 oldl,e,mco_kep 620 | c 621 | c Local 622 | real*8 l,pi,twopi,piby2,u1,u2,ome,sign 623 | real*8 x,x2,sn,dsn,z1,z2,z3,f0,f1,f2,f3 624 | real*8 p,q,p2,ss,cc 625 | logical flag,big,bigg 626 | c 627 | c------------------------------------------------------------------------------ 628 | c 629 | pi = 3.141592653589793d0 630 | twopi = 2.d0 * pi 631 | piby2 = .5d0 * pi 632 | c 633 | c Reduce mean anomaly to lie in the range 0 < l < pi 634 | if (oldl.ge.0) then 635 | l = mod(oldl, twopi) 636 | else 637 | l = mod(oldl, twopi) + twopi 638 | end if 639 | sign = 1.d0 640 | if (l.gt.pi) then 641 | l = twopi - l 642 | sign = -1.d0 643 | end if 644 | c 645 | ome = 1.d0 - e 646 | c 647 | if (l.ge..45d0.or.e.lt..55d0) then 648 | c 649 | c Regions A,B or C in Nijenhuis 650 | c ----------------------------- 651 | c 652 | c Rough starting value for eccentric anomaly 653 | if (l.lt.ome) then 654 | u1 = ome 655 | else 656 | if (l.gt.(pi-1.d0-e)) then 657 | u1 = (l+e*pi)/(1.d0+e) 658 | else 659 | u1 = l + e 660 | end if 661 | end if 662 | c 663 | c Improved value using Halley's method 664 | flag = u1.gt.piby2 665 | if (flag) then 666 | x = pi - u1 667 | else 668 | x = u1 669 | end if 670 | x2 = x*x 671 | sn = x*(1.d0 + x2*(-.16605 + x2*.00761) ) 672 | dsn = 1.d0 + x2*(-.49815 + x2*.03805) 673 | if (flag) dsn = -dsn 674 | f2 = e*sn 675 | f0 = u1 - f2 - l 676 | f1 = 1.d0 - e*dsn 677 | u2 = u1 - f0/(f1 - .5d0*f0*f2/f1) 678 | else 679 | c 680 | c Region D in Nijenhuis 681 | c --------------------- 682 | c 683 | c Rough starting value for eccentric anomaly 684 | z1 = 4.d0*e + .5d0 685 | p = ome / z1 686 | q = .5d0 * l / z1 687 | p2 = p*p 688 | z2 = exp( log( dsqrt( p2*p + q*q ) + q )/1.5 ) 689 | u1 = 2.d0*q / ( z2 + p + p2/z2 ) 690 | c 691 | c Improved value using Newton's method 692 | z2 = u1*u1 693 | z3 = z2*z2 694 | u2 = u1 - .075d0*u1*z3 / (ome + z1*z2 + .375d0*z3) 695 | u2 = l + e*u2*( 3.d0 - 4.d0*u2*u2 ) 696 | end if 697 | c 698 | c Accurate value using 3rd-order version of Newton's method 699 | c N.B. Keep cos(u2) rather than sqrt( 1-sin^2(u2) ) to maintain accuracy! 700 | c 701 | c First get accurate values for u2 - sin(u2) and 1 - cos(u2) 702 | bigg = (u2.gt.piby2) 703 | if (bigg) then 704 | z3 = pi - u2 705 | else 706 | z3 = u2 707 | end if 708 | c 709 | big = (z3.gt.(.5d0*piby2)) 710 | if (big) then 711 | x = piby2 - z3 712 | else 713 | x = z3 714 | end if 715 | c 716 | x2 = x*x 717 | ss = 1.d0 718 | cc = 1.d0 719 | c 720 | ss = x*x2/6.*(1. - x2/20.*(1. - x2/42.*(1. - x2/72.*(1. - 721 | % x2/110.*(1. - x2/156.*(1. - x2/210.*(1. - x2/272.))))))) 722 | cc = x2/2.*(1. - x2/12.*(1. - x2/30.*(1. - x2/56.*(1. - 723 | % x2/ 90.*(1. - x2/132.*(1. - x2/182.*(1. - x2/240.*(1. - 724 | % x2/306.)))))))) 725 | c 726 | if (big) then 727 | z1 = cc + z3 - 1.d0 728 | z2 = ss + z3 + 1.d0 - piby2 729 | else 730 | z1 = ss 731 | z2 = cc 732 | end if 733 | c 734 | if (bigg) then 735 | z1 = 2.d0*u2 + z1 - pi 736 | z2 = 2.d0 - z2 737 | end if 738 | c 739 | f0 = l - u2*ome - e*z1 740 | f1 = ome + e*z2 741 | f2 = .5d0*e*(u2-z1) 742 | f3 = e/6.d0*(1.d0-z2) 743 | z1 = f0/f1 744 | z2 = f0/(f2*z1+f1) 745 | mco_kep = sign*( u2 + f0/((f3*z1+f2)*z2+f1) ) 746 | c 747 | c------------------------------------------------------------------------------ 748 | c 749 | return 750 | end 751 | c 752 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 753 | c 754 | c MCO_SINE.FOR (ErikSoft 17 April 1997) 755 | c 756 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 757 | c 758 | c Author: John E. Chambers 759 | c 760 | c Calculates sin and cos of an angle X (in radians). 761 | c 762 | c------------------------------------------------------------------------------ 763 | c 764 | subroutine mco_sine (x,sx,cx) 765 | c 766 | implicit none 767 | c 768 | c Input/Output 769 | real*8 x,sx,cx 770 | c 771 | c Local 772 | real*8 pi,twopi 773 | c 774 | c------------------------------------------------------------------------------ 775 | c 776 | pi = 3.141592653589793d0 777 | twopi = 2.d0 * pi 778 | c 779 | if (x.gt.0) then 780 | x = mod(x,twopi) 781 | else 782 | x = mod(x,twopi) + twopi 783 | end if 784 | c 785 | cx = cos(x) 786 | c 787 | if (x.gt.pi) then 788 | sx = -sqrt(1.d0 - cx*cx) 789 | else 790 | sx = sqrt(1.d0 - cx*cx) 791 | end if 792 | c 793 | c------------------------------------------------------------------------------ 794 | c 795 | return 796 | end 797 | c 798 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 799 | c 800 | c MCO_SINH.FOR (ErikSoft 12 June 1998) 801 | c 802 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 803 | c 804 | c Calculates sinh and cosh of an angle X (in radians) 805 | c 806 | c------------------------------------------------------------------------------ 807 | c 808 | subroutine mco_sinh (x,sx,cx) 809 | c 810 | implicit none 811 | c 812 | c Input/Output 813 | real*8 x,sx,cx 814 | c 815 | c------------------------------------------------------------------------------ 816 | c 817 | sx = sinh(x) 818 | cx = sqrt (1.d0 + sx*sx) 819 | c 820 | c------------------------------------------------------------------------------ 821 | c 822 | return 823 | end 824 | c 825 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 826 | c 827 | c MIO_AEI.FOR (ErikSoft 31 January 2001) 828 | c 829 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 830 | c 831 | c Author: John E. Chambers 832 | c 833 | c Creates a filename and opens a file to store aei information for an object. 834 | c The filename is based on the name of the object. 835 | c 836 | c------------------------------------------------------------------------------ 837 | c 838 | subroutine mio_aei (id,extn,unitnum,header,lenhead,mem,lmem) 839 | c 840 | implicit none 841 | include 'mercury.inc' 842 | c 843 | c Input/Output 844 | integer unitnum,lenhead,lmem(NMESS) 845 | character*4 extn 846 | character*8 id 847 | character*250 header 848 | character*80 mem(NMESS) 849 | c 850 | c Local 851 | integer j,k,itmp,nsub,lim(2,4) 852 | logical test 853 | character*1 bad(5) 854 | character*250 filename 855 | c 856 | c------------------------------------------------------------------------------ 857 | c 858 | data bad/ '*', '/', '.', ':', '&'/ 859 | c 860 | c Create a filename based on the object's name 861 | call mio_spl (8,id,nsub,lim) 862 | itmp = min(7,lim(2,1)-lim(1,1)) 863 | filename(1:itmp+1) = id(1:itmp+1) 864 | filename(itmp+2:itmp+5) = extn 865 | do j = itmp + 6, 250 866 | filename(j:j) = ' ' 867 | end do 868 | c 869 | c Check for inappropriate characters in the filename 870 | do j = 1, itmp + 1 871 | do k = 1, 5 872 | if (filename(j:j).eq.bad(k)) filename(j:j) = '_' 873 | end do 874 | end do 875 | c 876 | c If the file exists already, give a warning and don't overwrite it 877 | inquire (file=filename, exist=test) 878 | if (test) then 879 | write (*,'(/,3a)') mem(121)(1:lmem(121)),mem(87)(1:lmem(87)), 880 | % filename(1:80) 881 | unitnum = -1 882 | else 883 | open (unitnum, file=filename, status='new') 884 | write (unitnum, '(/,30x,a8,//,a)') id,header(1:lenhead) 885 | end if 886 | c 887 | c------------------------------------------------------------------------------ 888 | c 889 | return 890 | end 891 | c 892 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 893 | c 894 | c MIO_C2FL.FOR (ErikSoft 5 June 2001) 895 | c 896 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 897 | c 898 | c CHARACTER*8 ASCII string into a REAL*8 variable. 899 | c 900 | c N.B. X will lie in the range -1.e112 < X < 1.e112 901 | c === 902 | c 903 | c------------------------------------------------------------------------------ 904 | c 905 | function mio_c2fl (c) 906 | c 907 | implicit none 908 | c 909 | c Input/Output 910 | real*8 mio_c2fl 911 | character*8 c 912 | c 913 | c Local 914 | real*8 x,mio_c2re 915 | integer ex 916 | c 917 | c------------------------------------------------------------------------------ 918 | c 919 | x = mio_c2re (c(1:8), 0.d0, 1.d0, 7) 920 | x = x * 2.d0 - 1.d0 921 | ex = mod(ichar(c(8:8)) + 256, 256) - 32 - 112 922 | mio_c2fl = x * (10.d0**dble(ex)) 923 | c 924 | c------------------------------------------------------------------------------ 925 | c 926 | return 927 | end 928 | c 929 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 930 | c 931 | c MIO_C2RE.FOR (ErikSoft 5 June 2001) 932 | c 933 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 934 | c 935 | c Author: John E. Chambers 936 | c 937 | c Converts an ASCII string into a REAL*8 variable X, where XMIN <= X < XMAX, 938 | c using the new format compression: 939 | c 940 | c X is assumed to be made up of NCHAR base-224 digits, each one represented 941 | c by a character in the ASCII string. Each digit is given by the ASCII 942 | c number of the character minus 32. 943 | c The first 32 ASCII characters (CTRL characters) are avoided, because they 944 | c cause problems when using some operating systems. 945 | c 946 | c------------------------------------------------------------------------------ 947 | c 948 | function mio_c2re (c,xmin,xmax,nchar) 949 | c 950 | implicit none 951 | c 952 | c Input/output 953 | integer nchar 954 | real*8 xmin,xmax,mio_c2re 955 | character*8 c 956 | c 957 | c Local 958 | integer j 959 | real*8 y 960 | c 961 | c------------------------------------------------------------------------------ 962 | c 963 | y = 0 964 | do j = nchar, 1, -1 965 | y = (y + dble(mod(ichar(c(j:j)) + 256, 256) - 32)) / 224.d0 966 | end do 967 | c 968 | mio_c2re = xmin + y * (xmax - xmin) 969 | c 970 | c------------------------------------------------------------------------------ 971 | c 972 | return 973 | end 974 | c 975 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 976 | c 977 | c MIO_ERR.FOR (ErikSoft 6 December 1999) 978 | c 979 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 980 | c 981 | c Author: John E. Chambers 982 | c 983 | c Writes out an error message and terminates Mercury. 984 | c 985 | c------------------------------------------------------------------------------ 986 | c 987 | subroutine mio_err (unit,s1,ls1,s2,ls2,s3,ls3,s4,ls4) 988 | c 989 | implicit none 990 | c 991 | c Input/Output 992 | integer unit,ls1,ls2,ls3,ls4 993 | character*80 s1,s2,s3,s4 994 | c 995 | c------------------------------------------------------------------------------ 996 | c 997 | write (*,'(a)') ' ERROR: Programme terminated.' 998 | write (unit,'(/,3a,/,2a)') s1(1:ls1),s2(1:ls2),s3(1:ls3), 999 | % ' ',s4(1:ls4) 1000 | stop 1001 | c 1002 | c------------------------------------------------------------------------------ 1003 | c 1004 | end 1005 | c 1006 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1007 | c 1008 | c MCO_H2B.FOR (ErikSoft 2 November 2000) 1009 | c 1010 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1011 | c 1012 | c Author: John E. Chambers 1013 | c 1014 | c Converts coordinates with respect to the central body to barycentric 1015 | c coordinates. 1016 | c 1017 | c------------------------------------------------------------------------------ 1018 | c 1019 | subroutine mco_h2b (jcen,nbod,nbig,h,m,xh,vh,x,v) 1020 | c 1021 | implicit none 1022 | c 1023 | c Input/Output 1024 | integer nbod,nbig 1025 | real*8 jcen(3),h,m(nbod),xh(3,nbod),vh(3,nbod),x(3,nbod),v(3,nbod) 1026 | c 1027 | c Local 1028 | integer j 1029 | real*8 mtot,temp 1030 | c 1031 | c------------------------------------------------------------------------------ 1032 | c 1033 | mtot = 0.d0 1034 | x(1,1) = 0.d0 1035 | x(2,1) = 0.d0 1036 | x(3,1) = 0.d0 1037 | v(1,1) = 0.d0 1038 | v(2,1) = 0.d0 1039 | v(3,1) = 0.d0 1040 | c 1041 | c Calculate coordinates and velocities of the central body 1042 | do j = 2, nbod 1043 | mtot = mtot + m(j) 1044 | x(1,1) = x(1,1) + m(j) * xh(1,j) 1045 | x(2,1) = x(2,1) + m(j) * xh(2,j) 1046 | x(3,1) = x(3,1) + m(j) * xh(3,j) 1047 | v(1,1) = v(1,1) + m(j) * vh(1,j) 1048 | v(2,1) = v(2,1) + m(j) * vh(2,j) 1049 | v(3,1) = v(3,1) + m(j) * vh(3,j) 1050 | enddo 1051 | c 1052 | temp = -1.d0 / (mtot + m(1)) 1053 | x(1,1) = temp * x(1,1) 1054 | x(2,1) = temp * x(2,1) 1055 | x(3,1) = temp * x(3,1) 1056 | v(1,1) = temp * v(1,1) 1057 | v(2,1) = temp * v(2,1) 1058 | v(3,1) = temp * v(3,1) 1059 | c 1060 | c Calculate the barycentric coordinates and velocities 1061 | do j = 2, nbod 1062 | x(1,j) = xh(1,j) + x(1,1) 1063 | x(2,j) = xh(2,j) + x(2,1) 1064 | x(3,j) = xh(3,j) + x(3,1) 1065 | v(1,j) = vh(1,j) + v(1,1) 1066 | v(2,j) = vh(2,j) + v(2,1) 1067 | v(3,j) = vh(3,j) + v(3,1) 1068 | enddo 1069 | c 1070 | c------------------------------------------------------------------------------ 1071 | c 1072 | return 1073 | end 1074 | c 1075 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1076 | c 1077 | c MCO_H2CB.FOR (ErikSoft 2 November 2000) 1078 | c 1079 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1080 | c 1081 | c Author: John E. Chambers 1082 | c 1083 | c Convert coordinates with respect to the central body to close-binary 1084 | c coordinates. 1085 | c 1086 | c------------------------------------------------------------------------------ 1087 | c 1088 | subroutine mco_h2cb (jcen,nbod,nbig,h,m,xh,vh,x,v) 1089 | c 1090 | implicit none 1091 | c 1092 | c Input/Output 1093 | integer nbod,nbig 1094 | real*8 jcen(3),h,m(nbod),xh(3,nbod),vh(3,nbod),x(3,nbod),v(3,nbod) 1095 | c 1096 | c Local 1097 | integer j 1098 | real*8 msum,mvsum(3),temp,mbin,mbin_1,mtot_1 1099 | c 1100 | c------------------------------------------------------------------------------ 1101 | c 1102 | msum = 0.d0 1103 | mvsum(1) = 0.d0 1104 | mvsum(2) = 0.d0 1105 | mvsum(3) = 0.d0 1106 | mbin = m(1) + m(2) 1107 | mbin_1 = 1.d0 / mbin 1108 | c 1109 | x(1,2) = xh(1,2) 1110 | x(2,2) = xh(2,2) 1111 | x(3,2) = xh(3,2) 1112 | temp = m(1) * mbin_1 1113 | v(1,2) = temp * vh(1,2) 1114 | v(2,2) = temp * vh(2,2) 1115 | v(3,2) = temp * vh(3,2) 1116 | c 1117 | do j = 3, nbod 1118 | msum = msum + m(j) 1119 | mvsum(1) = mvsum(1) + m(j) * vh(1,j) 1120 | mvsum(2) = mvsum(2) + m(j) * vh(2,j) 1121 | mvsum(3) = mvsum(3) + m(j) * vh(3,j) 1122 | end do 1123 | mtot_1 = 1.d0 / (msum + mbin) 1124 | mvsum(1) = mtot_1 * (mvsum(1) + m(2)*vh(1,2)) 1125 | mvsum(2) = mtot_1 * (mvsum(2) + m(2)*vh(2,2)) 1126 | mvsum(3) = mtot_1 * (mvsum(3) + m(2)*vh(3,2)) 1127 | c 1128 | temp = m(2) * mbin_1 1129 | do j = 3, nbod 1130 | x(1,j) = xh(1,j) - temp * xh(1,2) 1131 | x(2,j) = xh(2,j) - temp * xh(2,2) 1132 | x(3,j) = xh(3,j) - temp * xh(3,2) 1133 | v(1,j) = vh(1,j) - mvsum(1) 1134 | v(2,j) = vh(2,j) - mvsum(2) 1135 | v(3,j) = vh(3,j) - mvsum(3) 1136 | end do 1137 | c 1138 | c------------------------------------------------------------------------------ 1139 | c 1140 | return 1141 | end 1142 | c 1143 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1144 | c 1145 | c MCO_H2J.FOR (ErikSoft 2 November 2000) 1146 | c 1147 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1148 | c 1149 | c Author: John E. Chambers 1150 | c 1151 | c Converts coordinates with respect to the central body to Jacobi coordinates. 1152 | c Note that the Jacobi coordinates of all small bodies are assumed to be the 1153 | c same as their coordinates with respect to the central body. 1154 | c 1155 | c------------------------------------------------------------------------------ 1156 | c 1157 | subroutine mco_h2j (jcen,nbod,nbig,h,m,xh,vh,x,v) 1158 | c 1159 | implicit none 1160 | c 1161 | c Input/Output 1162 | integer nbod,nbig 1163 | real*8 jcen(3),h,m(nbig),xh(3,nbig),vh(3,nbig),x(3,nbig),v(3,nbig) 1164 | c 1165 | c Local 1166 | integer j 1167 | real*8 mtot, mx, my, mz, mu, mv, mw, temp 1168 | c 1169 | c------------------------------------------------------------------------------c 1170 | mtot = m(2) 1171 | x(1,2) = xh(1,2) 1172 | x(2,2) = xh(2,2) 1173 | x(3,2) = xh(3,2) 1174 | v(1,2) = vh(1,2) 1175 | v(2,2) = vh(2,2) 1176 | v(3,2) = vh(3,2) 1177 | mx = m(2) * xh(1,2) 1178 | my = m(2) * xh(2,2) 1179 | mz = m(2) * xh(3,2) 1180 | mu = m(2) * vh(1,2) 1181 | mv = m(2) * vh(2,2) 1182 | mw = m(2) * vh(3,2) 1183 | c 1184 | do j = 3, nbig - 1 1185 | temp = 1.d0 / (mtot + m(1)) 1186 | mtot = mtot + m(j) 1187 | x(1,j) = xh(1,j) - temp * mx 1188 | x(2,j) = xh(2,j) - temp * my 1189 | x(3,j) = xh(3,j) - temp * mz 1190 | v(1,j) = vh(1,j) - temp * mu 1191 | v(2,j) = vh(2,j) - temp * mv 1192 | v(3,j) = vh(3,j) - temp * mw 1193 | mx = mx + m(j) * xh(1,j) 1194 | my = my + m(j) * xh(2,j) 1195 | mz = mz + m(j) * xh(3,j) 1196 | mu = mu + m(j) * vh(1,j) 1197 | mv = mv + m(j) * vh(2,j) 1198 | mw = mw + m(j) * vh(3,j) 1199 | enddo 1200 | c 1201 | if (nbig.gt.2) then 1202 | temp = 1.d0 / (mtot + m(1)) 1203 | x(1,nbig) = xh(1,nbig) - temp * mx 1204 | x(2,nbig) = xh(2,nbig) - temp * my 1205 | x(3,nbig) = xh(3,nbig) - temp * mz 1206 | v(1,nbig) = vh(1,nbig) - temp * mu 1207 | v(2,nbig) = vh(2,nbig) - temp * mv 1208 | v(3,nbig) = vh(3,nbig) - temp * mw 1209 | end if 1210 | c 1211 | do j = nbig + 1, nbod 1212 | x(1,j) = xh(1,j) 1213 | x(2,j) = xh(2,j) 1214 | x(3,j) = xh(3,j) 1215 | v(1,j) = vh(1,j) 1216 | v(2,j) = vh(2,j) 1217 | v(3,j) = vh(3,j) 1218 | end do 1219 | c 1220 | c------------------------------------------------------------------------------ 1221 | c 1222 | return 1223 | end 1224 | c 1225 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1226 | c 1227 | c MCO_IDEN.FOR (ErikSoft 2 November 2000) 1228 | c 1229 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1230 | c 1231 | c Author: John E. Chambers 1232 | c 1233 | c Makes a new copy of a set of coordinates. 1234 | c 1235 | c------------------------------------------------------------------------------ 1236 | c 1237 | subroutine mco_iden (jcen,nbod,nbig,h,m,xh,vh,x,v) 1238 | c 1239 | implicit none 1240 | c 1241 | c Input/Output 1242 | integer nbod,nbig 1243 | real*8 jcen(3),h,m(nbod),x(3,nbod),v(3,nbod),xh(3,nbod),vh(3,nbod) 1244 | c 1245 | c Local 1246 | integer j 1247 | c 1248 | c------------------------------------------------------------------------------ 1249 | c 1250 | do j = 1, nbod 1251 | x(1,j) = xh(1,j) 1252 | x(2,j) = xh(2,j) 1253 | x(3,j) = xh(3,j) 1254 | v(1,j) = vh(1,j) 1255 | v(2,j) = vh(2,j) 1256 | v(3,j) = vh(3,j) 1257 | enddo 1258 | c 1259 | c------------------------------------------------------------------------------ 1260 | c 1261 | return 1262 | end 1263 | c 1264 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1265 | c 1266 | c MCO_X2EL.FOR (ErikSoft 20 February 2001) 1267 | c 1268 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1269 | c 1270 | c Author: John E. Chambers 1271 | c 1272 | c Calculates Keplerian orbital elements given relative coordinates and 1273 | c velocities, and GM = G times the sum of the masses. 1274 | c 1275 | c The elements are: q = perihelion distance 1276 | c e = eccentricity 1277 | c i = inclination 1278 | c p = longitude of perihelion (NOT argument of perihelion!!) 1279 | c n = longitude of ascending node 1280 | c l = mean anomaly (or mean longitude if e < 1.e-8) 1281 | c 1282 | c------------------------------------------------------------------------------ 1283 | c 1284 | subroutine mco_x2el (gm,x,y,z,u,v,w,q,e,i,p,n,l) 1285 | c 1286 | implicit none 1287 | include 'mercury.inc' 1288 | c 1289 | c Input/Output 1290 | real*8 gm,q,e,i,p,n,l,x,y,z,u,v,w 1291 | c 1292 | c Local 1293 | real*8 hx,hy,hz,h2,h,v2,r,rv,s,true 1294 | real*8 ci,to,temp,tmp2,bige,f,cf,ce 1295 | c 1296 | c------------------------------------------------------------------------------ 1297 | c 1298 | hx = y * w - z * v 1299 | hy = z * u - x * w 1300 | hz = x * v - y * u 1301 | h2 = hx*hx + hy*hy + hz*hz 1302 | v2 = u * u + v * v + w * w 1303 | rv = x * u + y * v + z * w 1304 | r = sqrt(x*x + y*y + z*z) 1305 | h = sqrt(h2) 1306 | s = h2 / gm 1307 | c 1308 | c Inclination and node 1309 | ci = hz / h 1310 | if (abs(ci).lt.1) then 1311 | i = acos (ci) 1312 | n = atan2 (hx,-hy) 1313 | if (n.lt.0) n = n + TWOPI 1314 | else 1315 | if (ci.gt.0) i = 0.d0 1316 | if (ci.lt.0) i = PI 1317 | n = 0.d0 1318 | end if 1319 | c 1320 | c Eccentricity and perihelion distance 1321 | temp = 1.d0 + s * (v2 / gm - 2.d0 / r) 1322 | if (temp.le.0) then 1323 | e = 0.d0 1324 | else 1325 | e = sqrt (temp) 1326 | end if 1327 | q = s / (1.d0 + e) 1328 | c 1329 | c True longitude 1330 | if (hy.ne.0) then 1331 | to = -hx/hy 1332 | temp = (1.d0 - ci) * to 1333 | tmp2 = to * to 1334 | true = atan2((y*(1.d0+tmp2*ci)-x*temp),(x*(tmp2+ci)-y*temp)) 1335 | else 1336 | true = atan2(y * ci, x) 1337 | end if 1338 | if (ci.lt.0) true = true + PI 1339 | c 1340 | if (e.lt.3.d-8) then 1341 | p = 0.d0 1342 | l = true 1343 | else 1344 | ce = (v2*r - gm) / (e*gm) 1345 | c 1346 | c Mean anomaly for ellipse 1347 | if (e.lt.1) then 1348 | if (abs(ce).gt.1) ce = sign(1.d0,ce) 1349 | bige = acos(ce) 1350 | if (rv.lt.0) bige = TWOPI - bige 1351 | l = bige - e*sin(bige) 1352 | else 1353 | c 1354 | c Mean anomaly for hyperbola 1355 | if (ce.lt.1) ce = 1.d0 1356 | bige = log( ce + sqrt(ce*ce-1.d0) ) 1357 | if (rv.lt.0) bige = - bige 1358 | l = e*sinh(bige) - bige 1359 | end if 1360 | c 1361 | c Longitude of perihelion 1362 | cf = (s - r) / (e*r) 1363 | if (abs(cf).gt.1) cf = sign(1.d0,cf) 1364 | f = acos(cf) 1365 | if (rv.lt.0) f = TWOPI - f 1366 | p = true - f 1367 | p = mod (p + TWOPI + TWOPI, TWOPI) 1368 | end if 1369 | c 1370 | if (l.lt.0.and.e.lt.1) l = l + TWOPI 1371 | if (l.gt.TWOPI.and.e.lt.1) l = mod (l, TWOPI) 1372 | c 1373 | c------------------------------------------------------------------------------ 1374 | c 1375 | return 1376 | end 1377 | c 1378 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1379 | c 1380 | c MIO_JD_Y.FOR (ErikSoft 2 June 1998) 1381 | c 1382 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1383 | c 1384 | c Author: John E. Chambers 1385 | c 1386 | c Converts from Julian day number to Julian/Gregorian Calendar dates, assuming 1387 | c the dates are those used by the English calendar. 1388 | c 1389 | c Algorithm taken from `Practical Astronomy with your calculator' (1988) 1390 | c by Peter Duffett-Smith, 3rd edition, C.U.P. 1391 | c 1392 | c Algorithm for negative Julian day numbers (Julian calendar assumed) by 1393 | c J. E. Chambers. 1394 | c 1395 | c N.B. The output date is with respect to the Julian Calendar on or before 1396 | c === 4th October 1582, and with respect to the Gregorian Calendar on or 1397 | c after 15th October 1582. 1398 | c 1399 | c 1400 | c------------------------------------------------------------------------------ 1401 | c 1402 | subroutine mio_jd_y (jd0,year,month,day) 1403 | c 1404 | implicit none 1405 | c 1406 | c Input/Output 1407 | real*8 jd0,day 1408 | integer year,month 1409 | c 1410 | c Local 1411 | integer i,a,b,c,d,e,g 1412 | real*8 jd,f,temp,x,y,z 1413 | c 1414 | c------------------------------------------------------------------------------ 1415 | c 1416 | if (jd0.le.0) goto 50 1417 | c 1418 | jd = jd0 + 0.5d0 1419 | i = sign( dint(dabs(jd)), jd ) 1420 | f = jd - 1.d0*i 1421 | c 1422 | c If on or after 15th October 1582 1423 | if (i.gt.2299160) then 1424 | temp = (1.d0*i-1867216.25d0) / 36524.25d0 1425 | a = sign( dint(dabs(temp)), temp ) 1426 | temp = .25d0 * a 1427 | b = i + 1 + a - sign( dint(dabs(temp)), temp ) 1428 | else 1429 | b = i 1430 | end if 1431 | c 1432 | c = b + 1524 1433 | temp = (1.d0*c - 122.1d0) / 365.25d0 1434 | d = sign( dint(dabs(temp)), temp ) 1435 | temp = 365.25d0 * d 1436 | e = sign( dint(dabs(temp)), temp ) 1437 | temp = (c-e) / 30.6001d0 1438 | g = sign( dint(dabs(temp)), temp ) 1439 | c 1440 | temp = 30.6001d0 * g 1441 | day = 1.d0*(c-e) + f - 1.d0*sign( dint(dabs(temp)), temp ) 1442 | c 1443 | if (g.le.13) month = g - 1 1444 | if (g.gt.13) month = g - 13 1445 | c 1446 | if (month.gt.2) year = d - 4716 1447 | if (month.le.2) year = d - 4715 1448 | c 1449 | if (day.gt.32) then 1450 | day = day - 32 1451 | month = month + 1 1452 | end if 1453 | c 1454 | if (month.gt.12) then 1455 | month = month - 12 1456 | year = year + 1 1457 | end if 1458 | return 1459 | c 1460 | 50 continue 1461 | c 1462 | c Algorithm for negative Julian day numbers (Duffett-Smith won't work) 1463 | x = jd0 - 2232101.5 1464 | f = x - dint(x) 1465 | if (f.lt.0) f = f + 1.d0 1466 | y = dint(mod(x,1461.d0) + 1461.d0) 1467 | z = dint(mod(y,365.25d0)) 1468 | month = int((z + 0.5d0) / 30.61d0) 1469 | day = dint(z + 1.5d0 - 30.61d0*dble(month)) + f 1470 | month = mod(month + 2, 12) + 1 1471 | c 1472 | year = 1399 + int (x / 365.25d0) 1473 | if (x.lt.0) year = year - 1 1474 | if (month.lt.3) year = year + 1 1475 | c 1476 | c------------------------------------------------------------------------------ 1477 | c 1478 | return 1479 | end 1480 | c 1481 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1482 | c 1483 | c MIO_SPL.FOR (ErikSoft 14 November 1999) 1484 | c 1485 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1486 | c 1487 | c Author: John E. Chambers 1488 | c 1489 | c Given a character string STRING, of length LEN bytes, the routine finds 1490 | c the beginnings and ends of NSUB substrings present in the original, and 1491 | c delimited by spaces. The positions of the extremes of each substring are 1492 | c returned in the array DELIMIT. 1493 | c Substrings are those which are separated by spaces or the = symbol. 1494 | c 1495 | c------------------------------------------------------------------------------ 1496 | c 1497 | subroutine mio_spl (len,string,nsub,delimit) 1498 | c 1499 | implicit none 1500 | c 1501 | c Input/Output 1502 | integer len,nsub,delimit(2,100) 1503 | character*1 string(len) 1504 | c 1505 | c Local 1506 | integer j,k 1507 | character*1 c 1508 | c 1509 | c------------------------------------------------------------------------------ 1510 | c 1511 | nsub = 0 1512 | j = 0 1513 | c = ' ' 1514 | delimit(1,1) = -1 1515 | c 1516 | c Find the start of string 1517 | 10 j = j + 1 1518 | if (j.gt.len) goto 99 1519 | c = string(j) 1520 | if (c.eq.' '.or.c.eq.'=') goto 10 1521 | c 1522 | c Find the end of string 1523 | k = j 1524 | 20 k = k + 1 1525 | if (k.gt.len) goto 30 1526 | c = string(k) 1527 | if (c.ne.' '.and.c.ne.'=') goto 20 1528 | c 1529 | c Store details for this string 1530 | 30 nsub = nsub + 1 1531 | delimit(1,nsub) = j 1532 | delimit(2,nsub) = k - 1 1533 | c 1534 | if (k.lt.len) then 1535 | j = k 1536 | goto 10 1537 | end if 1538 | c 1539 | 99 continue 1540 | c 1541 | c------------------------------------------------------------------------------ 1542 | c 1543 | return 1544 | end 1545 | c 1546 | *********************************************************************** 1547 | c ORBEL_FHYBRID.F 1548 | *********************************************************************** 1549 | * PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. 1550 | * 1551 | * Input: 1552 | * e ==> eccentricity anomaly. (real scalar) 1553 | * n ==> hyperbola mean anomaly. (real scalar) 1554 | * Returns: 1555 | * orbel_fhybrid ==> eccentric anomaly. (real scalar) 1556 | * 1557 | * ALGORITHM: For abs(N) < 0.636*ecc -0.6 , use FLON 1558 | * For larger N, uses FGET 1559 | * REMARKS: 1560 | * AUTHOR: M. Duncan 1561 | * DATE WRITTEN: May 26,1992. 1562 | * REVISIONS: 1563 | * REVISIONS: 2/26/93 hfl 1564 | *********************************************************************** 1565 | 1566 | real*8 function orbel_fhybrid(e,n) 1567 | 1568 | include 'swift.inc' 1569 | 1570 | c... Inputs Only: 1571 | real*8 e,n 1572 | 1573 | c... Internals: 1574 | real*8 abn 1575 | real*8 orbel_flon,orbel_fget 1576 | 1577 | c---- 1578 | c... Executable code 1579 | 1580 | abn = n 1581 | if(n.lt.0.d0) abn = -abn 1582 | 1583 | if(abn .lt. 0.636d0*e -0.6d0) then 1584 | orbel_fhybrid = orbel_flon(e,n) 1585 | else 1586 | orbel_fhybrid = orbel_fget(e,n) 1587 | endif 1588 | 1589 | return 1590 | end ! orbel_fhybrid 1591 | c------------------------------------------------------------------- 1592 | c 1593 | *********************************************************************** 1594 | c ORBEL_FGET.F 1595 | *********************************************************************** 1596 | * PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. 1597 | * 1598 | * Input: 1599 | * e ==> eccentricity anomaly. (real scalar) 1600 | * capn ==> hyperbola mean anomaly. (real scalar) 1601 | * Returns: 1602 | * orbel_fget ==> eccentric anomaly. (real scalar) 1603 | * 1604 | * ALGORITHM: Based on pp. 70-72 of Fitzpatrick's book "Principles of 1605 | * Cel. Mech. ". Quartic convergence from Danby's book. 1606 | * REMARKS: 1607 | * AUTHOR: M. Duncan 1608 | * DATE WRITTEN: May 11, 1992. 1609 | * REVISIONS: 2/26/93 hfl 1610 | c Modified by JEC 1611 | *********************************************************************** 1612 | 1613 | real*8 function orbel_fget(e,capn) 1614 | 1615 | include 'swift.inc' 1616 | 1617 | c... Inputs Only: 1618 | real*8 e,capn 1619 | 1620 | c... Internals: 1621 | integer i,IMAX 1622 | real*8 tmp,x,shx,chx 1623 | real*8 esh,ech,f,fp,fpp,fppp,dx 1624 | PARAMETER (IMAX = 10) 1625 | 1626 | c---- 1627 | c... Executable code 1628 | 1629 | c Function to solve "Kepler's eqn" for F (here called 1630 | c x) for given e and CAPN. 1631 | 1632 | c begin with a guess proposed by Danby 1633 | if( capn .lt. 0.d0) then 1634 | tmp = -2.d0*capn/e + 1.8d0 1635 | x = -log(tmp) 1636 | else 1637 | tmp = +2.d0*capn/e + 1.8d0 1638 | x = log( tmp) 1639 | endif 1640 | 1641 | orbel_fget = x 1642 | 1643 | do i = 1,IMAX 1644 | call mco_sinh (x,shx,chx) 1645 | esh = e*shx 1646 | ech = e*chx 1647 | f = esh - x - capn 1648 | c write(6,*) 'i,x,f : ',i,x,f 1649 | fp = ech - 1.d0 1650 | fpp = esh 1651 | fppp = ech 1652 | dx = -f/fp 1653 | dx = -f/(fp + dx*fpp/2.d0) 1654 | dx = -f/(fp + dx*fpp/2.d0 + dx*dx*fppp/6.d0) 1655 | orbel_fget = x + dx 1656 | c If we have converged here there's no point in going on 1657 | if(abs(dx) .le. TINY) RETURN 1658 | x = orbel_fget 1659 | enddo 1660 | 1661 | write(6,*) 'FGET : RETURNING WITHOUT COMPLETE CONVERGENCE' 1662 | return 1663 | end ! orbel_fget 1664 | c------------------------------------------------------------------ 1665 | c 1666 | *********************************************************************** 1667 | c ORBEL_FLON.F 1668 | *********************************************************************** 1669 | * PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. 1670 | * 1671 | * Input: 1672 | * e ==> eccentricity anomaly. (real scalar) 1673 | * capn ==> hyperbola mean anomaly. (real scalar) 1674 | * Returns: 1675 | * orbel_flon ==> eccentric anomaly. (real scalar) 1676 | * 1677 | * ALGORITHM: Uses power series for N in terms of F and Newton,s method 1678 | * REMARKS: ONLY GOOD FOR LOW VALUES OF N (N < 0.636*e -0.6) 1679 | * AUTHOR: M. Duncan 1680 | * DATE WRITTEN: May 26, 1992. 1681 | * REVISIONS: 1682 | *********************************************************************** 1683 | 1684 | real*8 function orbel_flon(e,capn) 1685 | 1686 | include 'swift.inc' 1687 | 1688 | c... Inputs Only: 1689 | real*8 e,capn 1690 | 1691 | c... Internals: 1692 | integer iflag,i,IMAX 1693 | real*8 a,b,sq,biga,bigb 1694 | real*8 x,x2 1695 | real*8 f,fp,dx 1696 | real*8 diff 1697 | real*8 a0,a1,a3,a5,a7,a9,a11 1698 | real*8 b1,b3,b5,b7,b9,b11 1699 | PARAMETER (IMAX = 10) 1700 | PARAMETER (a11 = 156.d0,a9 = 17160.d0,a7 = 1235520.d0) 1701 | PARAMETER (a5 = 51891840.d0,a3 = 1037836800.d0) 1702 | PARAMETER (b11 = 11.d0*a11,b9 = 9.d0*a9,b7 = 7.d0*a7) 1703 | PARAMETER (b5 = 5.d0*a5, b3 = 3.d0*a3) 1704 | 1705 | c---- 1706 | c... Executable code 1707 | 1708 | 1709 | c Function to solve "Kepler's eqn" for F (here called 1710 | c x) for given e and CAPN. Only good for smallish CAPN 1711 | 1712 | iflag = 0 1713 | if( capn .lt. 0.d0) then 1714 | iflag = 1 1715 | capn = -capn 1716 | endif 1717 | 1718 | a1 = 6227020800.d0 * (1.d0 - 1.d0/e) 1719 | a0 = -6227020800.d0*capn/e 1720 | b1 = a1 1721 | 1722 | c Set iflag nonzero if capn < 0., in which case solve for -capn 1723 | c and change the sign of the final answer for F. 1724 | c Begin with a reasonable guess based on solving the cubic for small F 1725 | 1726 | 1727 | a = 6.d0*(e-1.d0)/e 1728 | b = -6.d0*capn/e 1729 | sq = sqrt(0.25*b*b +a*a*a/27.d0) 1730 | biga = (-0.5*b + sq)**0.3333333333333333d0 1731 | bigb = -(+0.5*b + sq)**0.3333333333333333d0 1732 | x = biga + bigb 1733 | c write(6,*) 'cubic = ',x**3 +a*x +b 1734 | orbel_flon = x 1735 | c If capn is tiny (or zero) no need to go further than cubic even for 1736 | c e =1. 1737 | if( capn .lt. TINY) go to 100 1738 | 1739 | do i = 1,IMAX 1740 | x2 = x*x 1741 | f = a0 +x*(a1+x2*(a3+x2*(a5+x2*(a7+x2*(a9+x2*(a11+x2)))))) 1742 | fp = b1 +x2*(b3+x2*(b5+x2*(b7+x2*(b9+x2*(b11 + 13.d0*x2))))) 1743 | dx = -f/fp 1744 | c write(6,*) 'i,dx,x,f : ' 1745 | c write(6,432) i,dx,x,f 1746 | 432 format(1x,i3,3(2x,1p1e22.15)) 1747 | orbel_flon = x + dx 1748 | c If we have converged here there's no point in going on 1749 | if(abs(dx) .le. TINY) go to 100 1750 | x = orbel_flon 1751 | enddo 1752 | 1753 | c Abnormal return here - we've gone thru the loop 1754 | c IMAX times without convergence 1755 | if(iflag .eq. 1) then 1756 | orbel_flon = -orbel_flon 1757 | capn = -capn 1758 | endif 1759 | write(6,*) 'FLON : RETURNING WITHOUT COMPLETE CONVERGENCE' 1760 | diff = e*sinh(orbel_flon) - orbel_flon - capn 1761 | write(6,*) 'N, F, ecc*sinh(F) - F - N : ' 1762 | write(6,*) capn,orbel_flon,diff 1763 | return 1764 | 1765 | c Normal return here, but check if capn was originally negative 1766 | 100 if(iflag .eq. 1) then 1767 | orbel_flon = -orbel_flon 1768 | capn = -capn 1769 | endif 1770 | 1771 | return 1772 | end ! orbel_flon 1773 | c------------------------------------------------------------------ 1774 | c 1775 | *********************************************************************** 1776 | c ORBEL_ZGET.F 1777 | *********************************************************************** 1778 | * PURPOSE: Solves the equivalent of Kepler's eqn. for a parabola 1779 | * given Q (Fitz. notation.) 1780 | * 1781 | * Input: 1782 | * q ==> parabola mean anomaly. (real scalar) 1783 | * Returns: 1784 | * orbel_zget ==> eccentric anomaly. (real scalar) 1785 | * 1786 | * ALGORITHM: p. 70-72 of Fitzpatrick's book "Princ. of Cel. Mech." 1787 | * REMARKS: For a parabola we can solve analytically. 1788 | * AUTHOR: M. Duncan 1789 | * DATE WRITTEN: May 11, 1992. 1790 | * REVISIONS: May 27 - corrected it for negative Q and use power 1791 | * series for small Q. 1792 | *********************************************************************** 1793 | 1794 | real*8 function orbel_zget(q) 1795 | 1796 | include 'swift.inc' 1797 | 1798 | c... Inputs Only: 1799 | real*8 q 1800 | 1801 | c... Internals: 1802 | integer iflag 1803 | real*8 x,tmp 1804 | 1805 | c---- 1806 | c... Executable code 1807 | 1808 | iflag = 0 1809 | if(q.lt.0.d0) then 1810 | iflag = 1 1811 | q = -q 1812 | endif 1813 | 1814 | if (q.lt.1.d-3) then 1815 | orbel_zget = q*(1.d0 - (q*q/3.d0)*(1.d0 -q*q)) 1816 | else 1817 | x = 0.5d0*(3.d0*q + sqrt(9.d0*(q**2) +4.d0)) 1818 | tmp = x**(1.d0/3.d0) 1819 | orbel_zget = tmp - 1.d0/tmp 1820 | endif 1821 | 1822 | if(iflag .eq.1) then 1823 | orbel_zget = -orbel_zget 1824 | q = -q 1825 | endif 1826 | 1827 | return 1828 | end ! orbel_zget 1829 | c---------------------------------------------------------------------- 1830 | 1831 | 1832 | -------------------------------------------------------------------------------- /mercury.inc: -------------------------------------------------------------------------------- 1 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | c 3 | c MERCURY.INC (ErikSoft 4 March 2001) 4 | c 5 | c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | c 7 | c Author: John E. Chambers 8 | c 9 | c Parameters that you may want to alter at some point: 10 | c 11 | c NMAX = maximum number of bodies 12 | c CMAX = maximum number of close-encounter minima monitored simultaneously 13 | c NMESS = maximum number of messages in message.in 14 | c HUGE = an implausibly large number 15 | c NFILES = maximum number of files that can be open at the same time 16 | c 17 | integer NMAX, CMAX, NMESS, NFILES 18 | real*8 HUGE 19 | c 20 | parameter (NMAX = 2000) 21 | parameter (CMAX = 50) 22 | parameter (NMESS = 200) 23 | parameter (HUGE = 9.9d29) 24 | parameter (NFILES = 50) 25 | c 26 | c------------------------------------------------------------------------------ 27 | c 28 | c Constants: 29 | c 30 | c DR = conversion factor from degrees to radians 31 | c K2 = Gaussian gravitational constant squared 32 | c AU = astronomical unit in cm 33 | c MSUN = mass of the Sun in g 34 | c 35 | real*8 PI,TWOPI,PIBY2,DR,K2,AU,MSUN 36 | c 37 | parameter (PI = 3.141592653589793d0) 38 | parameter (TWOPI = PI * 2.d0) 39 | parameter (PIBY2 = PI * .5d0) 40 | parameter (DR = PI / 180.d0) 41 | parameter (K2 = 2.959122082855911d-4) 42 | parameter (AU = 1.4959787e13) 43 | parameter (MSUN = 1.9891e33) 44 | 45 | c RAS additions for binary 46 | 47 | c Is this a binary? (yes=.TRUE. no=.FALSE.) 48 | logical isbinary 49 | parameter (isbinary = .TRUE.) 50 | c Name for the central object ("foo") 51 | character*16 cenname 52 | parameter (cenname="STAR1") 53 | c Do we allow collisions or close encounters between the binary stars? (yes=.TRUE. no=.FALSE.) 54 | logical allowclose 55 | parameter (allowclose = .FALSE.) 56 | -------------------------------------------------------------------------------- /mercury6.man: -------------------------------------------------------------------------------- 1 | 2 | 3 | M A N U A L F O R T H E M E R C U R Y I N T E G R A T O R 4 | ================================================================= 5 | 6 | P A C K A G E V E R S I O N 6 7 | ================================= 8 | 9 | by John E. Chambers 10 | 11 | (with some subroutines supplied by Hal Levison and Martin Duncan) 12 | 13 | Dedicated to the memory of Fabio Migliorini 14 | 15 | 16 | Many thanks to all of you for reporting bugs and suggesting 17 | improvements. Special thanks to David Asher, Scott Manley and 18 | Eugenio Rivera for your help. 19 | 20 | < Last modified 1 March 2001 > 21 | 22 | 23 | N.B. If you publish the results of calculations using MERCURY, please 24 | === reference the package using J.E.Chambers (1999) ``A Hybrid 25 | Symplectic Integrator that Permits Close Encounters between 26 | Massive Bodies''. Monthly Notices of the Royal Astronomical 27 | Society, vol 304, pp793-799. 28 | 29 | 30 | C O N T E N T S 31 | =============== 32 | 33 | (1) Introduction 34 | 35 | (2) Initial preparations 36 | 37 | (3) How to do an integration 38 | 39 | (4) Converting data to orbital elements 40 | 41 | (5) Examining data on close encounters 42 | 43 | (6) Continuing an integration from dump files 44 | 45 | (7) Extending a previous integration 46 | 47 | (8) Note for previous users: Changes from Mercury5. 48 | 49 | ------------------------------------------------------------------------------ 50 | 51 | (1) I N T R O D U C T I O N 52 | ======================= 53 | 54 | MERCURY is a general-purpose software package for doing N-body 55 | integrations. It is designed to calculate the orbital evolution of 56 | objects moving in the gravitational field of a large central body. 57 | For example MERCURY can be used to simulate the motion of the planets, 58 | asteroids and comets orbiting the Sun; or a system of moons orbiting 59 | a planet; or a planetary system orbiting another star. 60 | 61 | MERCURY is written in Fortran 77. The code is slightly non standard 62 | (e.g. it contains `end do' statements) but it should work using most 63 | compilers. 64 | 65 | MERCURY currently includes the following N-body algorithms: 66 | 67 | o A second-order mixed-variable symplectic (MVS) algorithm 68 | incorporating simple symplectic correctors (see J.Wisdom et al. 69 | 1996, Fields Instit. Commun. vol 10 pp217) - this is very fast 70 | but it cannot compute close encounters between objects. 71 | 72 | o A general Bulirsch-Stoer - slow but accurate in most situations. 73 | You can use this when all else fails, or to test whether the other 74 | algorithms are appropriate for the problem you want to study. 75 | 76 | o Conservative Bulirsch-Stoer - twice as fast as the general BS 77 | routine, but it will only work for conservative systems, in which 78 | accelerations are a function of position only (e.g. Newtonian 79 | gravity, but not General Relativity). 80 | 81 | o Everhart's RA15 (RADAU) - about 2-3 times faster than the general 82 | version of Bulirsch-Stoer. Usually reliable, except for very close 83 | encounters or very eccentric (e.g. Sun grazing) orbits. 84 | 85 | o Hybrid symplectic/Bulirsch-Stoer integrator - very fast but only 86 | moderately accurate. This algorithm can compute close encounters. 87 | 88 | N.B. The symplectic integrators may give spurious results if some 89 | === objects have highly eccentric orbits during an integration. 90 | 91 | MERCURY includes the effects of Newtonian gravitational forces between 92 | bodies that are assumed to be point masses. It can also calculate 93 | non-gravitational forces for comets (using equations by B.Marsden et al. 94 | 1973. Astron. J. vol 78, pp211). You can include the effects of other 95 | forces, using some algorithms, by modifying the subroutine mfo_user.for. 96 | 97 | The MERCURY package consists of several drivers and subroutines, 98 | together with a number of input files that you may want to alter to 99 | suit your application. 100 | 101 | 102 | The Drivers 103 | ----------- 104 | 105 | 1) mercury6_1.for 106 | 107 | This is the basic integration programme. It contains all the 108 | subroutines you need to carry out integrations using any of the 109 | algorithms described above. mercury6_1.for produces some output files 110 | that are in a machine-independent compressed format, and you will 111 | need the following programmes to convert this output into a format 112 | you can read. 113 | 114 | 2) element6.for 115 | 116 | This programme converts an output file created by mercury6_1.for into 117 | a set of files containing Keplerian orbital elements for each of the 118 | objects in the integration. These files allow you to see how object's 119 | orbits change with time, and can be used as the basis for making 120 | graphs or movies using a graphics package. 121 | 122 | 3) close6.for 123 | 124 | This programme converts an output file produced by mercury6_1.for 125 | into a set of files containing details of close encounters between 126 | objects during the integration. 127 | 128 | 129 | Other files 130 | ----------- 131 | 132 | 1) mercury.inc 133 | 134 | This contains constants and general parameters used by programmes in 135 | the mercury package. You may want to alter some of the parameters before 136 | you compile and run mercury6_1.for 137 | 138 | 2) swift.inc 139 | 140 | This contains constants and parameters used in the subroutines written 141 | by H.Levison and M.Duncan (1994, Icarus, vol 108, pp18). These 142 | subroutines have names that begin with either `drift' or `orbel'. 143 | 144 | N.B. If you change mercury.inc or swift.inc, you must recompile the 145 | === driver programmes (mercury6_1.for etc) for the changes to take 146 | effect. 147 | 148 | ------------------------------------------------------------------------------ 149 | 150 | (2) I N I T I A L P R E P A R A T I O N S 151 | ======================================= 152 | 153 | Before using the MERCURY package for the first time, you should do the 154 | following: 155 | 156 | a) Make sure you have copies of these files: 157 | mercury6_1.for 158 | mercury.inc 159 | swift.inc 160 | element6.for 161 | close6.for 162 | message.in 163 | files.in 164 | You will need some additional input files to run the programmes in the 165 | MERCURY package, but you can create these yourself (see the following 166 | sections for details). 167 | 168 | b) Compile mercury6_1.for. The precise command you use will depend on 169 | your Fortran compiler. I suggest you call the executable version 170 | of the programme mercury6 171 | e.g. On Linux systems, try g77 -o mercury6 mercury6_1.for 172 | On DEC Unix systems, try f77 -o mercury6 mercury6_1.for 173 | 174 | c) Compile element6.for. I suggest you call the executable element6 175 | 176 | d) Compile close6.for. I suggest you call the executable close6 177 | 178 | ------------------------------------------------------------------------------ 179 | 180 | (3) H O W T O D O A N I N T E G R A T I O N 181 | =============================================== 182 | 183 | a) Make sure the compiled version of mercury6_1.for exists. 184 | 185 | b) Make sure each of the input files described below exists, and alter 186 | them to suit your needs. 187 | 188 | c) Run the compiled version of mercury6_1.for 189 | e.g. On Unix or Linux systems, use the command: ./mercury6 190 | 191 | For long integrations, you may want to run the programme in the 192 | background or as a batch job. 193 | 194 | d) Read the information summary file produced by mercury6_1.for to make 195 | sure that no problems occurred during the integration. You can read 196 | this file while mercury6_1.for is still running. 197 | 198 | 199 | The Input Files 200 | --------------- 201 | 202 | 1) files.in 203 | 204 | This should contain a list of 10 names for the input and output files 205 | used by mercury6_1.for. List each file name on a separate line. 206 | 207 | The first 3 names should be input files that already exist. 208 | In order, these are: 209 | 210 | i) A file containing initial data for the Big bodies in the integration 211 | (e.g. planets in the Solar System). 212 | 213 | ii) A file containing initial data for the Small bodies in the integration 214 | (e.g. asteroids or comets that you want to include). 215 | 216 | iii) A file containing parameters used by the integrator (e.g. start 217 | and end times of the integration etc.). 218 | 219 | The MERCURY package includes some sample versions of these files which 220 | you can use as templates. I call these big.in, small.in and param.in 221 | respectively. 222 | 223 | The last 7 names in files.in are the names that mercury6_1.for will use 224 | for its output files. In order, these will contain: 225 | 226 | iv) Position and velocity information for the objects in the 227 | integration, produced at periodic intervals. 228 | v) Details of close encounters that occur during the integration. 229 | vi) A summary of the integration parameters used in by the integrator, 230 | and a list of any events that took place (e.g. collisions between 231 | objects). 232 | vii) A dump file containing data for the Big bodies. You can use this 233 | to continue the integration if your computer crashes or the 234 | programme is interupted. 235 | viii) A dump file containing data for the Small bodies. 236 | ix) A dump file containing the integration parameters. 237 | x) An additional dump file containing other variables used by 238 | mercury6_1.for 239 | 240 | I usually call these 7 files xv.out, ce.out, info.out, big.dmp, 241 | small.dmp, param.dmp and restart.dmp 242 | 243 | 2) big.in 244 | 245 | This file contains the initial data for all the Big bodies in the 246 | integration EXCEPT for the central body (i.e. the Sun if you are 247 | integrating the Solar System). A Big body is defined as one that 248 | perturbs and interacts with all other objects during the integration. 249 | 250 | Any lines beginning with the ) character are assumed to be comments, 251 | and will be ignored by mercury6_1.for, however, you should not delete 252 | the first comment line beginning with )O+_06 253 | 254 | o The first non-comment line should end with a word that tells the 255 | programme what format you use for the initial data. You should specify 256 | either 257 | 258 | Cartesian = for xyz coordinates and velocities. Distances should be 259 | in AU and velocities in AU per day (1 day = 86400 seconds). 260 | 261 | Asteroidal = Keplerian orbital elements, in an `asteroidal' format. 262 | i.e. a e I g n M, where 263 | a = semi-major axis (in AU) 264 | e = eccentricity 265 | I = inclination (degrees) 266 | g = argument of pericentre (degrees) 267 | n = longitude of the ascending node (degrees) 268 | M = mean anomaly (degrees) 269 | 270 | Cometary = Keplerian orbital elements in a `cometary' format. 271 | i.e. q e I g n T, where 272 | q = pericentre distance (AU) 273 | e,I,g,n = as above 274 | T = epoch of pericentre (days) 275 | 276 | o The next line should end with the epoch of osculation in days (i.e. 277 | the time at which the initial coordinates/elements are valid). 278 | 279 | E.g. the first few lines of big.in might look like this: 280 | 281 | )O+_06 Big-body initial data (WARNING: Do not delete this line!!) 282 | ) Lines beginning with `)' are ignored. 283 | )--------------------------------------------------------------------- 284 | style (Cartesian, Asteroidal, Cometary) = Asteroid 285 | epoch (in days) = 2451544.5 286 | 287 | o The remaining lines provide data for each Big body. The first line 288 | for each body should begin with the body's name, having up to 8 289 | characters. 290 | After that you can include any of the following on the same line: 291 | 292 | m = X where X is a real number, to indicate the body's mass in 293 | Solar masses. If you don't specify a value the mass is 294 | assumed to be 0. 295 | 296 | r = X where X is a real number, to indicate the maximum 297 | distance from the body (in Hill radii) that constitutes 298 | a close encounter. If you don't include this the default 299 | is r=1 300 | 301 | d = X where X is a real number, to indicate the density of the 302 | body in g/cm^3. If you don't include this the default is d=1 303 | 304 | a1 = X where X is a real number, to indicate the A1 non-gravitational 305 | force parameter for this body. Realistically this should be 306 | zero for Big bodies (the default is 0). 307 | 308 | a2 = X where X is a real number, to indicate the A2 non-gravitational 309 | force parameter for this body (the default is 0). 310 | 311 | a3 = X where X is a real number, to indicate the A1 non-gravitational 312 | force parameter for this body (the default is 0). 313 | 314 | E.g. the line might look something like this: 315 | MARS m=3.22715144505386530E-07 d= 3.94 316 | 317 | The next line(s) for a body should contain the 6 initial coordinates and 318 | velocities or the 6 orbital elements, separated by one or more spaces or 319 | carriage returns. After these numbers you should give the 3 components 320 | of spin angular momentum for the body, in units of solar masses AU^2 per 321 | day (if in doubt enter these as 0). 322 | 323 | 324 | 3) small.in 325 | 326 | This file contains the initial data for all the Small bodies in the 327 | integration. A Small body is defined as one that only perturbs and 328 | interacts with Big bodies during the integration. Hence, Small bodies 329 | ignore one another completely (i.e they do not perturb one another, 330 | and they cannot collide with each other). 331 | If you give these objects zero mass they will behave as test particles. 332 | 333 | Any lines beginning with the ) character are assumed to be comments, 334 | and will be ignored by mercury6_1.for, however, you should not delete 335 | the first comment line beginning with )O+_06 336 | 337 | o The first non-comment line should end with a word that tells the 338 | programme what format you use for the initial data. The possible 339 | formats are the same as those in big.in 340 | 341 | o The remaining lines provide data for each Small body. These are 342 | exactly analogous to the lines in big.in, except that you can also 343 | specify an epoch of osculation for each Small body using 344 | 345 | ep = X where X is a real number. If you don't include this the 346 | default is X = the same as the epoch for the Big bodies. 347 | Small bodies with differing epochs will be integrated 348 | to the same epoch prior to the main integration. 349 | 350 | E.g. the line might look something like this: 351 | HALLEY Ep=2446480.5 a1=0.04d-8 A2 =0.0155d-8 352 | 353 | Note that if any of the Small bodies have different epochs than 354 | the Large bodies, the Small bodies must all have zero mass. 355 | 356 | 4) param.in 357 | 358 | This file contains parameters that control how an integration 359 | is carried out. Any lines beginning with the ) character are assumed 360 | to be comments, and will be ignored by mercury6_1.for, however, you 361 | should not delete the first comment line beginning with )O+_06 362 | 363 | The file should contain the following items, one per line and in 364 | this order (the programme actually searches for information after 365 | an `=' sign, so you may change the text of the message before this). 366 | 367 | o The integration algorithm. Choose one of the following: 368 | 369 | mvs : second-order mixed-variable symplectic 370 | bs : Bulirsch-Stoer (general) 371 | bs2 : " " (conservative systems only) 372 | radau : RA15 (RADAU) 373 | hybrid : hybrid symplectic/Bulirsch-Stoer integrator 374 | 375 | o The time that the integration should start (in days). This doesn't 376 | have to be the same as the epoch of the Big bodies. Rather, the 377 | integrator will start producing output at this date. If you are 378 | integrating objects in the Solar System, you may want to measure 379 | time in Julian Day numbers (e.g. 1st Jan 2000 = 2451544.5) 380 | 381 | o The time at which the integration will finish (in days). 382 | 383 | o The output interval (in days). This determines how often the 384 | programme will store orbital elements for the bodies. 385 | 386 | o The timestep used by the integrator (in days). For variable 387 | timestep algorithms (e.g. Bulirsch-Stoer and Radau), this is the 388 | stepsize used for the first timestep only. After that the programme 389 | will choose its own timestep. Note that if you choose a large 390 | initial timestep, the variable timestep algorithms may reduce it 391 | in order to maintain the desired accuracy. 392 | 393 | o A integration accuracy parameter. This is approximately how much 394 | error per step the variable-timestep algorithms will tolerate. 395 | It is also used by the hybrid algorithm during close approaches. 396 | This number is ignored by the MVS algorithm but you should 397 | provide a number anyway. 398 | 399 | The next lines in param.in should contain options that you will only 400 | want to change occasionally. If in doubt, you can use the same 401 | options as the sample param.in file. The options are: 402 | 403 | o Should the integrator stop if a close encounter occurs (yes or no)? 404 | 405 | o Should the programme check for collisions and take appropriate 406 | action if they occur (yes or no)? If you answer no, all the 407 | bodies will behave as point masses. 408 | 409 | o Should collisions result in fragmentation (yes or no)? This 410 | version of MERCURY does not include fragmentation, so this is 411 | ignored at present. You should still specify yes or no however. 412 | 413 | o How should the time be expressed (days or years)? This option 414 | controls how information messages produced by mercury6_1.for are 415 | formatted. 416 | 417 | o Should time be measured with respect to the integration start 418 | time (yes or no)? 419 | If you choose `years' and `no' for the previous option and this 420 | one, the time will expressed as a Julian date before October 421 | 1582, and as a Gregorian date for later dates. 422 | 423 | o What level of output precision (low, medium or high)? This 424 | determines how many significant figures will be used to store 425 | the orbital elements (roughly 4, 9 or 15). 426 | 427 | o This line is no longer used. However, for backwards compatibility, 428 | you should still include a line here in param.in, although it 429 | doesn't matter what you put on this line. 430 | 431 | o Include the effects of general relativity (yes or no)? This 432 | version of MERCURY does not include relativity, so this is 433 | ignored at present. 434 | 435 | o Include the effects of the user-defined force routine (yes or 436 | no). You can add additional forces to the integrator in the 437 | subroutine mfo_user in mercury6_1.for 438 | 439 | The remaining lines in param.in should contain some other parameters 440 | that you will only need to change rarely. These are: 441 | 442 | o The distance from the central body at which objects are 443 | removed (in AU). These bodies are assumed to be so far from 444 | the central body that they are no longer important. 445 | Note that this number is used to scale the output (on a log 446 | scale), so don't make it bigger than you need to. 447 | 448 | o The radius of the central body (in AU). Objects coming closer 449 | than this are assumed to collide with the central body. 450 | This number is also used to scale the output (on a log scale). 451 | 452 | o The mass of the central body (in solar masses). 453 | 454 | o The J2 moment of the central body in units of its radius^2. 455 | 456 | o The J4 moment of the central body in units of its radius^4. 457 | 458 | o The J6 moment of the central body in units of its radius^6. 459 | 460 | o A line which is not used at present. Write whatever you like 461 | on this line. 462 | 463 | o Another line which is not used at present. 464 | 465 | o The changeover distance used by the hybrid integrator (in Hill 466 | radii). This is the minimum separation between objects before 467 | the hybrid (close encounter) part of the integrator takes effect. 468 | 469 | o The maximum number of timesteps between data dumps. This also 470 | controls how often mercury6_1.for notifies you of its progress. 471 | 472 | o The number of timesteps between other periodic effects. At 473 | present this controls how often mercury6_1.for checks for 474 | ejections and recomputes objects' Hill radii. 475 | 476 | 5) message.in 477 | 478 | N.B. Alter the contents of this file at your peril!! 479 | === 480 | 481 | This file contains the text of various messages output by MERCURY, 482 | together with an index number and the number of characters in the string 483 | (including spaces used for alignment). 484 | 485 | ------------------------------------------------------------------------------ 486 | 487 | (4) C O N V E R T I N G D A T A T O O R B I T A L E L E M E N T S 488 | ===================================================================== 489 | 490 | After doing an integration you can see how the objects' orbits 491 | varied over time. To do so, follow these steps: 492 | 493 | a) Make sure the output files produced by the original integration still 494 | exist. 495 | 496 | b) Make sure the compiled version of element6.for exists. 497 | 498 | c) Make sure each of the input files described below exists, and alter 499 | them to suit your needs. 500 | 501 | d) Run the compiled version of element6.for 502 | e.g. On Unix/Linux systems, use the command: ./element6 503 | 504 | The programme will produce a set of new files, one per object, containing 505 | orbital elements. Each file has the name of the object with the extension 506 | .aei 507 | 508 | The Input Files 509 | --------------- 510 | 511 | 1) element.in 512 | 513 | This file contains parameters and options used by element6.for 514 | Any lines beginning with the ) character are assumed to be comments, 515 | and will be ignored by element6.for 516 | 517 | o In the first non-comment line, give the number N of compressed 518 | data files you want to read from. Usually this will be 1. 519 | (If you specify more than one file, element6.for will combine 520 | the orbital elements from all the integrations into one set 521 | of output files). 522 | 523 | o The next N lines should contain the name(s) of the compressed 524 | data file(s) produced by mercury6_1.for Put each file name on a 525 | different line. 526 | 527 | o At the end of the next line, indicate what origin you want to 528 | use for your elements. Choose between Central (for elements 529 | with respect to the central body), Barycentric (for barycentric 530 | elements) or Jacobi (for Jacobi elements). 531 | 532 | o On the next line, specify the minimum time interval between the 533 | times at which you would like orbital elements. For example, 534 | if the original integration stored data every 100 days, but you 535 | are only interested in seeing orbital elements every 500 days, 536 | put 500 on this line in elements.in 537 | 538 | o On the next line say whether you would like time expressed in days 539 | or years (write years or days). 540 | 541 | o Then, on a new line, state whether you want to express the time 542 | with respect to the integration start date (write yes or no). 543 | 544 | o Next comes a line indicating which orbital elements you want, 545 | and in what format. Each element is indicated by a code letter, 546 | followed by a number indicating the desired number of digits and 547 | decimal places. If the number of figures is followed by `e', then 548 | the programme will use exponential notation for that element. 549 | 550 | The code letters are: 551 | a = semi-major axis (in AU) 552 | b = apocentre distance (in AU, b is short for Big q) 553 | d = density (g per cm^3) 554 | e = eccentricity 555 | f = true anomaly (degrees) 556 | g = argument of perihelion (degrees) 557 | i = inclination (degrees) 558 | l = mean anomaly (degrees) 559 | m = mass (solar masses) 560 | n = longitude of ascending node 561 | o = obliquity (degrees) 562 | p = longitude of perihelion (degrees) 563 | q = pericentre distance (AU) 564 | r = radial distance (AU) 565 | s = spin period (days) 566 | x, y or z = Cartesian coordinates x, y or z 567 | u, v or w = Cartesian velocities vx, vy or vz 568 | 569 | E.g. a8.4 e8.6 i7.3 g7.3 n7.3 l7.3 m13e 570 | indicates that you want the semi-major axis (8 digits including 571 | 4 decimal places), eccentricity (8 digits including 6 decimal 572 | places) etc.... and mass (13 digits in exponential notation). 573 | 574 | Note that if you choose to express an element using a large number 575 | of significant figures, the last few digits might not be meaningful 576 | if the output precision of the original integation was low or medium. 577 | 578 | o The remaining lines in elements.in should contain the names of the 579 | objects for which you want orbital elements. If you don't supply 580 | any names, the programme assumes that you want elements for all the 581 | objects. 582 | 583 | 2) message.in 584 | 585 | This is the same file as used by mercury6_1.for 586 | 587 | 588 | ------------------------------------------------------------------------------ 589 | 590 | (5) E X A M I N I N G D A T A O N C L O S E E N C O U N T E R S 591 | =================================================================== 592 | 593 | To examine details of close encounters that occurred during an 594 | integration, follow these steps: 595 | 596 | a) Make sure the output files produced by the original integration still 597 | exist. 598 | 599 | b) Make sure the compiled version of close6.for exists. 600 | 601 | c) Make sure each of the input files described below exists, and alter 602 | them to suit your needs. 603 | 604 | d) Run the compiled version of close6.for 605 | e.g. On Unix/Linux systems, use the command: ./close6 606 | 607 | The programme will produce a set of new files, one per object, containing 608 | details of close encounters with that object. Each file has the name of 609 | the object with the extension .clo 610 | 611 | The Input Files 612 | --------------- 613 | 614 | 1) close.in 615 | 616 | This file contains parameters and options used by close6.for 617 | Any lines beginning with the ) character are assumed to be comments, 618 | and will be ignored by close6.for. Don't delete the first comment 619 | line though. 620 | 621 | o In the first non-comment line, give the number N of compressed 622 | data files you want to read from. Usually this will be 1. 623 | (If you specify more than one file, close6.for will combine 624 | close-encounter details from all the integrations into one set 625 | of output files). 626 | 627 | o The next N lines should contain the name(s) of the compressed 628 | data file(s) produced by mercury6_1.for Put each file name on a 629 | different line. 630 | 631 | o On the next line say whether you would like time expressed in days 632 | or years (write years or days in close.in). 633 | 634 | o Then, on a new line, state whether you want to express the time 635 | with respect to the integration start date (write yes or no). 636 | 637 | o The remaining lines in m_close.in should contain the names of the 638 | objects for which you want close-encounter details. If you don't 639 | supply any names, the programme assumes that you want details for 640 | all the objects. 641 | 642 | 2) message.in 643 | 644 | The same file as used by mercury6_1.for 645 | 646 | N.B. When using the hybrid symplectic algorithm, only those close 647 | === encounters that are integrated using the Bulirsch-Stoer part of 648 | the integrator will be saved. In practice, this means that some 649 | distant ``close'' encounters will not be recorded. 650 | 651 | ------------------------------------------------------------------------------ 652 | 653 | (6) C O N T I N U I N G A N I N T E G R A T I O N F R O M 654 | =========================================================== 655 | 656 | D U M P F I L E S 657 | =================== 658 | 659 | If your computer crashes while MERCURY is doing an integration, all is 660 | not lost. You can continue the integration from the point at which 661 | mercury6_1.for last saved data in dump files, rather than having to 662 | redo the whole calculation. Just follow these steps: 663 | 664 | a) Make sure all of the input, output and dump files used by the original 665 | integration are still present. 666 | 667 | b) Make sure the filenames listed in files.in correspond to these files. 668 | 669 | c) Run the compiled version of mercury6_1.for 670 | 671 | If for some reason one of the dump files has become corrupted, look 672 | to see if you still have a set of files with the extension .tmp 673 | produced during the original integration (if you have subsequently 674 | used mercury6_1.for to do another integration in the same directory, 675 | you will have lost these unfortunately). These .tmp files are duplicate 676 | copies of the dump files. Copy each one so that they form a set of 677 | uncorrupted dump files (e.g. copy big.tmp to big.dmp etc.), and then 678 | run the compiled version of mercury6_1.for 679 | 680 | N.B. It is important that you replace all the dump files with the .tmp 681 | === files in this way, rather than just the file that is corrupted. 682 | 683 | ------------------------------------------------------------------------------ 684 | 685 | (7) E X T E N D I N G A P R E V I O U S I N T E G R A T I O N 686 | =============================================================== 687 | 688 | If you want to extend an old integration that finished successfully 689 | (i.e. not one that crashed), follow these steps: 690 | 691 | a) Make sure all of the input, output and dump files used by the original 692 | integration are still present. 693 | 694 | b) Make sure the filenames listed in files.in correspond to these files. 695 | 696 | c) Change the finish time in the parameter dump file (see section 3) 697 | to the end point of the extended integration. 698 | 699 | d) Run the compiled version of mercury6_1.for 700 | 701 | ------------------------------------------------------------------------------ 702 | 703 | (8) C H A N G E S F R O M M E R C U R Y 5 704 | =========================================== 705 | 706 | The code has been restructured, primarily to make it easier to 707 | incorporate new coordinate systems (binary-star coordinates, and 708 | some others that I'm tinkering with, that are not included in this 709 | version). All the coordinate change routines now accept the same 710 | input and output (except going to/from Keplerian elements). 711 | A major result of this is that the arrays for objects are now 712 | indexed starting at 2 instead of 1 (the central body uses index 1). 713 | 714 | The compressed output has changed again (!! sorry about that). 715 | However, the new version is an improvement for a few reasons. 716 | Firstly, it makes it possible to choose your coordinate origin 717 | (central/barycentric/Jacobi) when you run the decompression 718 | programme rather than when you do the original integration. 719 | Secondly, it handles hyperbolic elements better - no more problems 720 | with the hyperbolic mean anomaly. In addition, you no longer have 721 | to specify emax or qmin in the param.in file - the new compressed 722 | format can handle all osculating values of q and e. Finally, it is 723 | now possible to produce .aei files when the number of objects in the 724 | integration exceeds the number of files that can be open at the 725 | same time for your operating system. 726 | 727 | Rather than remodifying m_elem.for to cope with yet another type 728 | of compressed output, I have written a new programme called elements 729 | (which is also easier to pronounce). Use this for compressed output 730 | generated by Mercury6, and use m_elem5 for the earlier versions of 731 | Mercury. 732 | 733 | A bug fix: Mercury5_2, and earlier, had a bug which occurred when 734 | integrating test particles using the MVS algorithm. This incorrectly 735 | modelled the perturbations due to the innermost massive body. 736 | 737 | The central-body oblateness terms J2, J4 and J6 now function. These 738 | were also included in a few older versions of Mercury, but were not 739 | properly tested until now. 740 | 741 | The MVS algorithm now incorporates simple symplectic correctors 742 | which should improve the accuracy using this algorithm. The 743 | correctors remove error terms proportional to eh^3 thru eh^6, where 744 | h is the timestep and e is the ratio of the object masses to the 745 | central mass. Hence, the leading error terms are proportional to 746 | e^2h^3 and eh^7. 747 | 748 | Close encounter details are now output in batches, rather than after 749 | every encounter. Furthermore, the programme does not always do regular 750 | data dumps in addition to data dumps at every output interval. These 751 | changes are made in the hope that they will reduce delays caused by 752 | accessing the hard disk. 753 | -------------------------------------------------------------------------------- /swift.inc: -------------------------------------------------------------------------------- 1 | c************************************************************************* 2 | c SWIFT.INC 3 | c************************************************************************* 4 | C Include file for SWIFT 5 | c 6 | c Author: Hal Levison 7 | c Date: 2/2/93 8 | c Last revision: 3/7/93 9 | 10 | implicit NONE ! you got it baby 11 | 12 | c... Maximum array size 13 | integer NPLMAX, NTPMAX 14 | parameter (NPLMAX = 202) ! max number of planets, including the Sun 15 | parameter (NTPMAX = 2000) ! max number of test particles 16 | 17 | c... Size of the test particle status flag 18 | integer NSTAT 19 | parameter (NSTAT = 3) 20 | 21 | c... convergence criteria for danby 22 | real*8 DANBYAC , DANBYB 23 | parameter (DANBYAC= 1.0d-14, DANBYB = 1.0d-13) 24 | 25 | c... loop limits in the Laguerre attempts 26 | integer NLAG1, NLAG2 27 | parameter(NLAG1 = 50, NLAG2 = 400) 28 | 29 | c... A small number 30 | real*8 TINY 31 | PARAMETER(TINY=4.D-15) 32 | 33 | c... trig stuff 34 | real*8 PI,TWOPI,PIBY2,DEGRAD 35 | parameter (PI = 3.141592653589793D0) 36 | parameter (TWOPI = 2.0D0 * PI) 37 | parameter (PIBY2 = PI/2.0D0) 38 | parameter (DEGRAD = 180.0D0 / PI) 39 | 40 | c------------------------------------------------------------------------- 41 | --------------------------------------------------------------------------------