https://github.com/florentrenaud/nbody6tt
Tip revision: 8a4716382ead3ece116c48a4ae5c65f8c9534437 authored by Florent on 29 January 2015, 12:19:28 UTC
Nbody6 - 29 January 2015 (added GPU2/Build/.gitkeep)
Nbody6 - 29 January 2015 (added GPU2/Build/.gitkeep)
Tip revision: 8a47163
kscorr.f
SUBROUTINE KSCORR(IPAIR,UI,UIDOT,FP,FD,TD2,TDOT4,TDOT5,TDOT6)
*
*
* Corrector for KS motion.
* ------------------------
*
INCLUDE 'common6.h'
COMMON/SLOW0/ RANGE,ISLOW(10)
REAL*8 UI(4),UIDOT(4),FP(6),FD(6),FREG(4),FRD(4),A1(3,4),A(8),
& PR(4),PRD(4),U2(4),U3(4),U4(4),U5(4),FD1(3)
PARAMETER (ITLOW=2)
*
*
* Convert from physical to regularized derivative using T' = R.
RI = R(IPAIR)
DO 1 K = 1,3
FD1(K) = FD(K)
FD(K) = RI*FD(K)
1 CONTINUE
*
* Include KS slow-down factor in the perturbation if ZMOD > 1.
IF (KZ(26).GT.0) THEN
IMOD = KSLOW(IPAIR)
IF (IMOD.GT.1) THEN
ZMOD = FLOAT(ISLOW(IMOD))
DO 5 K = 1,3
FP(K) = ZMOD*FP(K)
FD(K) = ZMOD*FD(K)
FD1(K) = ZMOD*FD1(K)
5 CONTINUE
END IF
END IF
*
* Predict DH from Taylor series derivatives and save temporary value.
DTU = DTAU(IPAIR)
DT3 = ONE6*DTU
DT4 = 0.25D0*DTU
DH = (((HDOT4(IPAIR)*DT4 + HDOT3(IPAIR))*DT3 +
& 0.5D0*HDOT2(IPAIR))*DTU + HDOT(IPAIR))*DTU
*
* Set time-step factors and copy Stumpff coefficients to scalars.
DTSQ = DTU**2
DT6 = 6.0/(DTU*DTSQ)
DT2 = 2.0/DTSQ
Z3 = SF(3,IPAIR)
Z4 = SF(4,IPAIR)
Z5 = SF(5,IPAIR)
*
* Define optimized scalars outside iteration loop.
DT5 = 0.2D0*DTU*Z5
DTZ = DT4*Z4
DH0 = (0.5D0*HDOT2(IPAIR)*DTU + HDOT(IPAIR))*DTU
*
* Use extra iteration and new KSPERT for large perturbation.
* IF (GAMMA(IPAIR).LT.1.0D-20) THEN
ITMAX = ITLOW
* ELSE
* ITMAX = ITLOW + 1
* I1 = 2*IPAIR - 1
* NNB0 = LIST(1,I1)
* I = N + IPAIR
* BODYIN = 1.0/BODY(I)
* END IF
*
* Perform iteration with or without re-calculating perturbation.
DO 40 ITER = 1,ITMAX
*
* Obtain new transformation matrix.
CALL MATRIX(UI,A1)
*
* Form twice regularized force and half first derivative of H.
HD = 0.0D0
TD2 = 0.0D0
DO 10 K = 1,4
A(K) = A1(1,K)*FP(1) + A1(2,K)*FP(2) + A1(3,K)*FP(3)
A(K+4) = A1(1,K)*FD(1) + A1(2,K)*FD(2) + A1(3,K)*FD(3)
PR(K) = RI*A(K)
FREG(K) = DH*UI(K) + PR(K)
HD = HD + UIDOT(K)*A(K)
TD2 = TD2 + UI(K)*UIDOT(K)
10 CONTINUE
*
* Set regularized velocity matrix (Levi-Civita matrix not required).
CALL MATRIX(UIDOT,A1)
*
* Include the whole (L*F)' term in explicit derivatives of FU & H'.
HD2 = 0.0D0
DO 15 K = 1,4
AK4 = A(K+4) + A1(1,K)*FP(1) + A1(2,K)*FP(2) +
& A1(3,K)*FP(3)
HD2 = HD2 + (H(IPAIR)*UI(K) + FREG(K))*A(K) +
& 2.0D0*UIDOT(K)*AK4
PRD(K) = 0.5D0*RI*AK4 + TD2*A(K)
FRD(K) = HD*UI(K) + 0.5D0*DH*UIDOT(K) + PRD(K)
* Form the regularized perturbation and modified force.
PR(K) = 0.5D0*PR(K)
FREG(K) = 0.5D0*FREG(K)
15 CONTINUE
*
* Determine new derivatives of U evaluated at beginning of the step.
DO 20 K = 1,4
DF = FP0(K,IPAIR) - FREG(K)
SUM = FD0(K,IPAIR) + FRD(K)
BT2 = -3.0D0*DF - (SUM + FD0(K,IPAIR))*DTU
AT3 = 2.0D0*DF + SUM*DTU
*
U2(K) = 0.5D0*H0(IPAIR)*U0(K,IPAIR) + FP0(K,IPAIR)
U3(K) = 0.5D0*H0(IPAIR)*UDOT(K,IPAIR) + FD0(K,IPAIR)
U4(K) = 0.5D0*H0(IPAIR)*U2(K) + BT2*DT2
U5(K) = 0.5D0*H0(IPAIR)*U3(K) + AT3*DT6
20 CONTINUE
*
* Improve the solution of U and UDOT.
DO 25 K = 1,4
UI(K) = ((((U5(K)*DT5 + U4(K)*Z4)*DT4 + U3(K))*DT3 +
& 0.5*U2(K))*DTU + UDOT(K,IPAIR))*DTU + U0(K,IPAIR)
UIDOT(K) = (((U5(K)*DTZ + U4(K)*Z3)*DT3 +
& 0.5*U3(K))*DTU + U2(K))*DTU + UDOT(K,IPAIR)
25 CONTINUE
*
* Update the physical distance for next iteration or final solution.
RI = UI(1)**2 + UI(2)**2 + UI(3)**2 + UI(4)**2
*
* Choose between old and new perturbation (skip last time).
* IF (ITER.GT.ITMAX) THEN
* IF (GAMMA(IPAIR).LT.1.0D-04) THEN
* DO 30 K = 1,3
* FD(K) = RI*FD1(K)
* 30 CONTINUE
* ELSE
* Transform to improved coordinates & velocities.
* CALL KSTRAN(IPAIR,I1,I,BODYIN,RI,UI,UIDOT,XI,VI)
*
* Re-calculate the perturbing force & derivative.
* CALL KSPERT(I1,NNB0,XI,VI,FP,FD)
*
* Convert to regularized derivative (note slow-down not active).
* DO 35 K = 1,3
* FD(K) = RI*FD(K)
* 35 CONTINUE
* END IF
* END IF
*
* Re-evaluate DH by adding Hermite corrector.
HD = 2.0D0*HD
DHD = HDOT(IPAIR) - HD
SUM = HDOT2(IPAIR) + HD2
BT2 = -3.0D0*DHD - (SUM + HDOT2(IPAIR))*DTU
AT3 = 2.0D0*DHD + SUM*DTU
DH = DH0 + (0.25D0*AT3 + ONE3*BT2)*DTU
40 CONTINUE
*
* Copy final values and set higher derivatives.
H(IPAIR) = H(IPAIR) + DH
DO 50 K = 1,4
U(K,IPAIR) = UI(K)
U0(K,IPAIR) = UI(K)
UDOT(K,IPAIR) = UIDOT(K)
FUDOT2(K,IPAIR) = U4(K) + U5(K)*DTU
FUDOT3(K,IPAIR) = U5(K)
AK4 = A(K+4) + A1(1,K)*FP(1) + A1(2,K)*FP(2) + A1(3,K)*FP(3)
PR(K) = 0.5D0*RI*A(K)
PRD(K) = 0.5D0*RI*AK4 + TD2*A(K) + 0.5D0*HD*UI(K)
FP0(K,IPAIR) = PR(K)
FD0(K,IPAIR) = PRD(K)
50 CONTINUE
*
* Save new derivatives of H.
HDOT(IPAIR) = HD
HDOT2(IPAIR) = HD2
HDOT3(IPAIR) = (3.0D0*AT3 + BT2)*DT2
HDOT4(IPAIR) = AT3*DT6
*
* Set new FU/2 & FUDOT/6 and form scalar terms for time derivatives.
TD2 = 0.0D0
TD3 = 0.0D0
TDOT4 = 0.0D0
TDOT5 = 0.0D0
TDOT6 = 0.0D0
H2 = 0.5D0*H(IPAIR)
DO 60 K = 1,4
U2K = PR(K) + H2*UI(K)
U3K = PRD(K) + H2*UIDOT(K)
FU(K,IPAIR) = 0.5D0*U2K
FUDOT(K,IPAIR) = ONE6*U3K
TD2 = TD2 + UI(K)*UIDOT(K)
TD3 = TD3 + UIDOT(K)**2 + UI(K)*U2K
TDOT4 = TDOT4 + UI(K)*U3K + 3.0D0*UIDOT(K)*U2K
TDOT5 = TDOT5 + 0.5D0*FUDOT2(K,IPAIR)*UI(K) +
& 2.0D0*U3K*UIDOT(K) + 1.5D0*U2K**2
TDOT6 = TDOT6 + U5(K)*UI(K) + 5.0D0*U4(K)*UIDOT(K) +
& 10.0D0*U3K*U2K
* Note that TDOT4/2, TDOT5/4 and TDOT6/2 are calculated.
60 CONTINUE
*
* Save distance and second & third time derivatives.
R(IPAIR) = RI
TDOT2(IPAIR) = 2.0D0*TD2
TDOT3(IPAIR) = 2.0D0*TD3
*
RETURN
*
END