9 common/chreg/ timec,tmax,rmaxc,cm(10),namec(6),nstep1,kz27,kz30
10 common/ccoll2/ qk(nmx4),pk(nmx4),rij(nmx,nmx),
SIZE(nmx),vstar1,
11 & ecoll1,rcoll,qperi,istar(nmx),icoll,isync,ndiss1
13 REAL*8 g0(3),radius(2),de(2)
15 DATA eccm,eccm2 /0.002,0.00000399/
20 r1 = max(
SIZE(k1),
SIZE(k2))
21 IF (abs(qperi - 4.0*r1).LT.0.01*qperi)
THEN
44 ecc = 1.0 - 1.0/(rinv(im)*semi)
47 am0 = semi*(1.0d0 - ecc**2)
53 CALL
chaos2(k1,k2,ecc,h,is,mb,mu,radius,semi1,ecc1,dh,idis,
56 IF (kstari.EQ.-1) go to 2
62 am0 = semi*(1.0d0 - ecc**2)
65 acirc = am0/(1.0 - ecc2)
67 IF (acirc.LT.4.0*r1)
THEN
71 ecc1 = 0.25*am0/r1 - 1.0
74 semi1 = am0/(1.0 - ecc1**2)
77 dh = 0.5*mb*(1.0/semi - 1.0/semi1)
82 CALL
tides3(qperi,m(k1),m(k2),vstar1,h,ecc,de)
84 dh = -(de(1) + de(2))/mu
85 IF (h + dh.LT.-0.5*mb*rinv(im))
THEN
86 dh = -0.5*mb*rinv(im) - h
88 semi1 = -0.5*mb/(h + dh)
89 ecc1 = 1.0 -
peri/semi1
90 ecc1 = max(ecc1,0.0d0)
109 IF (h + dh.GT.0.0) go to 90
112 2 peri1 = semi1*(1.0d0 - ecc1)
117 c1 = sqrt(peri1/
peri)
120 IF (kz27.EQ.1.OR.kstari.EQ.-2)
THEN
123 c2 = sqrt((mb + h*peri1)/(mb + hi*
peri))
128 IF (ecc1.LE.eccm.AND.kz27.EQ.1)
THEN
129 am = semi1*(1.0d0 - ecc1**2)
136 v02 = mb*(2.0/qperi - 1.0/semi)
140 IF (a1**2.GT.a2)
THEN
141 a3 = a1 + sqrt(a1**2 - a2)
144 WRITE (6,5) a1, a2, sqrt(1.0/a3), a3, c1
145 5
FORMAT (
' WARNING! QPMOD A1 A2 SQRT(1/A3) A3 C1 ',
146 & 1p,2e10.2,0p,3f12.6)
152 IF (kz27.EQ.2.AND.kstari.EQ.-1)
THEN
153 c2 = sqrt((h + mb/peri1)/(hi + mb/
peri))
171 vb = (pi(j1+k) + pi(j2+k))/mb
173 p1k = c2*(m(k2)*pi(j1+k) - m(k1)*pi(j2+k))/mb
174 pi(j1+k) = m(k1)*vb + p1k
175 pi(j2+k) = m(k2)*vb - p1k
190 wc(l+k) = wc(l+k-3) - pi(l+k)
203 p(ks1) = 2.d0*(+q(ks1)*wc(l1) + q(ks2)*wc(l2) + q(ks3)*wc(l3))
204 p(ks2) = 2.d0*(-q(ks2)*wc(l1) + q(ks1)*wc(l2) + q(ks4)*wc(l3))
205 p(ks3) = 2.d0*(-q(ks3)*wc(l1) - q(ks4)*wc(l2) + q(ks1)*wc(l3))
206 p(ks4) = 2.d0*(+q(ks4)*wc(l1) - q(ks3)*wc(l2) + q(ks2)*wc(l3))
216 pot1 = pot1 + mij(i,j)*rinv(ij)
239 ecoll1 = ecoll1 - mu*dh + (pot1 - pot0)
245 CALL
const(x,v,m,n,en1,g0,alag)
247 WRITE (6,75) en1, en1-
energy, mu*dh, semi, semi1, dpot
248 75
FORMAT (/,
' QPMOD: EN1 ERR DE A A1 DP ',
253 IF (ecc.GT.eccm.AND.ecc1.LE.eccm)
THEN
258 IF (ecc.GT.0.99.OR.kz30.GT.1)
THEN
259 WRITE (6,80) namec(k1), namec(k2), semi1, ecc, ecc1, h, qperi
260 80
FORMAT (
' NEW QPMOD NAM AF E0 EF H QP ',
261 & 2i6,1p,e10.2,0p,2f8.4,f9.1,1p,2e10.2)
265 CALL
stablc(im,iterm,semi1)