https://github.com/nbodyx/Nbody6
Tip revision: dff3b5c68673d4d4c4c9f54c8ba110b8416098f2 authored by nitadori on 31 May 2020, 13:04:00 UTC
Avoided touching uninitialized SEMIX
Avoided touching uninitialized SEMIX
Tip revision: dff3b5c
kspert.f
SUBROUTINE KSPERT(I1,NNB0,XI,VI,FP,FD)
*
*
* Perturbation on KS pair.
* ------------------------
*
INCLUDE 'common6.h'
COMMON/CHAINC/ XC(3,NCMAX),UC(3,NCMAX),BODYC(NCMAX),ICH,
& LISTC(LMAX)
REAL*8 XI(6),VI(6),FP(6),FD(6),TF(3),TD(3)
SAVE NNB2
*
*
* Initialize the perturbing force & first derivative.
DO 10 K = 1,6
FP(K) = 0.0D0
FD(K) = 0.0D0
10 CONTINUE
*
* Set index of the last single perturber.
NNB2 = NNB0 + 1
15 IF (LIST(NNB2,I1).LE.N) GO TO 20
NNB2 = NNB2 - 1
IF (NNB2.GT.1) GO TO 15
* Include special case of only c.m. perturbers.
GO TO 30
*
* Obtain the perturbation from single particles.
* 20 DO 25 L = 2,NNB2
* K = LIST(L,I1)
* A1 = X(1,K) - XI(1)
* A2 = X(2,K) - XI(2)
* A3 = X(3,K) - XI(3)
* RIJ2 = A1*A1 + A2*A2 + A3*A3
* A6 = BODY(K)/(RIJ2*SQRT(RIJ2))
* FP(1) = FP(1) + A1*A6
* FP(2) = FP(2) + A2*A6
* FP(3) = FP(3) + A3*A6
* V1 = XDOT(1,K) - VI(1)
* V2 = XDOT(2,K) - VI(2)
* V3 = XDOT(3,K) - VI(3)
* A9 = 3.0D0*(A1*V1 + A2*V2 + A3*V3)/RIJ2
* FD(1) = FD(1) + (V1 - A1*A9)*A6
* FD(2) = FD(2) + (V2 - A2*A9)*A6
* FD(3) = FD(3) + (V3 - A3*A9)*A6
* Perturbation on first component.
*
* A1 = X(1,K) - XI(4)
* A2 = X(2,K) - XI(5)
* A3 = X(3,K) - XI(6)
* RIJ2 = A1*A1 + A2*A2 + A3*A3
* A6 = BODY(K)/(RIJ2*SQRT(RIJ2))
* FP(4) = FP(4) + A1*A6
* FP(5) = FP(5) + A2*A6
* FP(6) = FP(6) + A3*A6
* V1 = XDOT(1,K) - VI(4)
* V2 = XDOT(2,K) - VI(5)
* V3 = XDOT(3,K) - VI(6)
* A9 = 3.0D0*(A1*V1 + A2*V2 + A3*V3)/RIJ2
* FD(4) = FD(4) + (V1 - A1*A9)*A6
* FD(5) = FD(5) + (V2 - A2*A9)*A6
* FD(6) = FD(6) + (V3 - A3*A9)*A6
* Perturbation on second component.
* 25 CONTINUE
*
* Employ the special procedure for standard double force loop.
20 I2 = I1 + 1
DO 28 K = 1,3
X(K,I1) = XI(K)
X(K,I2) = XI(K+3)
XDOT(K,I1) = VI(K)
XDOT(K,I2) = VI(K+3)
28 CONTINUE
CALL CNBINT(I1,X,XDOT,BODY,NNB2,LIST(2,I1),FP,FD)
CALL CNBINT(I2,X,XDOT,BODY,NNB2,LIST(2,I1),FP(4),FD(4))
*
* See whether to include any remaining c.m. perturbers.
IF (NNB2.GT.NNB0) GO TO 40
*
30 KDUM = 0
* Dummy index to enable summation of c.m. or resolved components.
NNB3 = NNB2 + 1
DO 35 L = NNB3,NNB0+1
K = LIST(L,I1)
CALL JPRED(K)
A1 = X(1,K) - XI(1)
A2 = X(2,K) - XI(2)
A3 = X(3,K) - XI(3)
RIJ2 = A1*A1 + A2*A2 + A3*A3
* See whether c.m. approximation applies (ignore unperturbed case).
J = K - N
IF (RIJ2.GT.CMSEP2*R(J)**2) THEN
V1 = XDOT(1,K) - VI(1)
V2 = XDOT(2,K) - VI(2)
V3 = XDOT(3,K) - VI(3)
A9 = 3.0D0*(A1*V1 + A2*V2 + A3*V3)/RIJ2
GO TO 33
END IF
*
* Resolve pair #J and sum over individual components.
CALL KSRES2(J,J1,J2,RIJ2)
KDUM = J1
K = KDUM
32 A1 = X(1,K) - XI(1)
A2 = X(2,K) - XI(2)
A3 = X(3,K) - XI(3)
RIJ2 = A1*A1 + A2*A2 + A3*A3
V1 = XDOT(1,K) - VI(1)
V2 = XDOT(2,K) - VI(2)
V3 = XDOT(3,K) - VI(3)
A9 = 3.0D0*(A1*V1 + A2*V2 + A3*V3)/RIJ2
33 A6 = BODY(K)/(RIJ2*SQRT(RIJ2))
FP(1) = FP(1) + A1*A6
FP(2) = FP(2) + A2*A6
FP(3) = FP(3) + A3*A6
FD(1) = FD(1) + (V1 - A1*A9)*A6
FD(2) = FD(2) + (V2 - A2*A9)*A6
FD(3) = FD(3) + (V3 - A3*A9)*A6
* Perturbation on first component.
*
A1 = X(1,K) - XI(4)
A2 = X(2,K) - XI(5)
A3 = X(3,K) - XI(6)
RIJ2 = A1*A1 + A2*A2 + A3*A3
A6 = BODY(K)/(RIJ2*SQRT(RIJ2))
FP(4) = FP(4) + A1*A6
FP(5) = FP(5) + A2*A6
FP(6) = FP(6) + A3*A6
V1 = XDOT(1,K) - VI(4)
V2 = XDOT(2,K) - VI(5)
V3 = XDOT(3,K) - VI(6)
A9 = 3.0D0*(A1*V1 + A2*V2 + A3*V3)/RIJ2
FD(4) = FD(4) + (V1 - A1*A9)*A6
FD(5) = FD(5) + (V2 - A2*A9)*A6
FD(6) = FD(6) + (V3 - A3*A9)*A6
* Perturbation on second component.
*
IF (K.EQ.KDUM) THEN
K = K + 1
GO TO 32
END IF
35 CONTINUE
*
* Check perturbation correction due to regularized chain.
40 IF (NCH.GT.0) THEN
DO 45 L = 2,NNB2
J = LIST(L,I1)
IF (J.GT.ICH) GO TO 50
IF (J.EQ.ICH) THEN
J1 = I1
CALL FCHAIN(J1,0,XI(1),VI(1),FP(1),FD(1))
J1 = J1 + 1
CALL FCHAIN(J1,1,XI(4),VI(4),FP(4),FD(4))
GO TO 50
END IF
45 CONTINUE
END IF
*
* Set the relative perturbing force and first derivative.
50 DO 55 K = 1,3
FP(K) = FP(K) - FP(K+3)
FD(K) = FD(K) - FD(K+3)
TF(K) = 0.0D0
TD(K) = 0.0D0
55 CONTINUE
*
* See whether the linearized perturbation should be included.
IF (KZ(14).GT.0.AND.KZ(14).LT.3) THEN
Q1 = XI(1) - XI(4)
Q3 = XI(3) - XI(6)
CALL XTRNLP(Q1,Q3,TF)
*
* Use same formalism for the first derivative (omit Coriolis force).
VX = VI(1) - VI(4)
VZ = VI(3) - VI(6)
CALL XTRNLP(VX,VZ,TD)
DO 60 K = 1,3
FP(K) = FP(K) + TF(K)
FD(K) = FD(K) + TD(K)
60 CONTINUE
END IF
*
* Check optional Plummer potential.
IF (KZ(14).EQ.4.OR.KZ(14).EQ.3) THEN
RI2 = AP2
RRDOT = 0.0
* Form one central distance and scalar product of relative motion.
DO 65 K = 1,3
RI2 = RI2 + XI(K)**2
RRDOT = RRDOT + (XI(K) - XI(K+3))*(VI(K) - VI(K+3))
65 CONTINUE
ZF = 1.0/RI2
FMP = MP*ZF*SQRT(ZF)
DO 70 K = 1,3
XREL = XI(K) - XI(K+3)
VREL = VI(K) - VI(K+3)
FP(K) = FP(K) - XREL*FMP
FD(K) = FD(K) - (VREL - 3.0*RRDOT*ZF*XREL)*FMP
70 CONTINUE
END IF
*
RETURN
*
END