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
UPDATE
*
* Modify the list of previously regularized binaries.
NNB = LISTR(1) - 1
L = 0
91 L = L + 2
92 IF (L.GT.NNB + 1) GO TO 96
J = LISTR(L)
K = LISTR(L+1)
* First check the current two-body separation of any old pairs.
RJK2 = (X(1,J) - X(1,K))**2 + (X(2,J) - X(2,K))**2 +
& (X(3,J) - X(3,K))**2
* Remove pair if RJK > 4*RMIN when special procedure not needed.
IF (RJK2.LT.16.0*RMIN**2) GO TO 91
DO 94 K = L,NNB
LISTR(K) = LISTR(K+2)
94 CONTINUE
NNB = NNB - 2
GO TO 92
*
* Add ICOMP & JCOMP to LISTR (maximum of MLR/2 - 1 pairs).
96 IF (NNB.GT.MLR - 4) THEN
* Note that NNB is one less than the actual membership.
DO 98 K = 2,NNB
LISTR(K) = LISTR(K+2)
98 CONTINUE
NNB = NNB - 2
* Removal of the oldest KS pair.
END IF
LISTR(NNB+3) = ICOMP
LISTR(NNB+4) = JCOMP
LISTR(1) = NNB + 3
*
* Copy flag index of disrupted pair (set in KSTERM).
IFLAG = JLIST(3)
* Add primordial pairs to LISTD (skip new KS pairs or primordials).
IF (IFLAG.EQ.0.OR.IABS(JLIST(1) - JLIST(2)).EQ.1) GO TO 110
*
* Check list of disrupted component names.
NNB = LISTD(1) - 1
KCOMP = 0
DO 100 K = 2,NNB+1,2
IF (LISTD(K).EQ.JLIST(1).AND.LISTD(K+1).EQ.JLIST(2)) KCOMP = 1
100 CONTINUE
*
* Include both components unless already members.
IF (KCOMP.EQ.0) THEN
IF (NNB.GT.MLD - 4) THEN
DO 102 K = 2,NNB
LISTD(K) = LISTD(K+2)
102 CONTINUE
NNB = NNB - 2
END IF
* Add most recent names at the end (limit is MLD/2 - 1 pairs).
LISTD(NNB+3) = JLIST(1)
LISTD(NNB+4) = JLIST(2)
LISTD(1) = NNB + 3
END IF
IF (IFLAG.NE.-1) WRITE (8,104) IPAIR, IFLAG, JLIST(1), JLIST(2)
104 FORMAT (' LISTD INCONSISTENCY!! IPAIR IFLAG NAMES ',2I5,2I8)
*
* Update list of high velocity particles containing c.m. members.
110 NNB = LISTV(1)
DO 130 L = 2,NNB+1
IF (LISTV(L).EQ.ICM) THEN
* Remove old c.m. and reduce the membership.
DO 125 K = L,NNB
LISTV(K) = LISTV(K+1)
125 CONTINUE
LISTV(1) = LISTV(1) - 1
END IF
* Reduce higher particle locations by one.
IF (LISTV(L).GT.ICM) THEN
LISTV(L) = LISTV(L) - 1
END IF
130 CONTINUE
*